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PREFACE 

The  untimely  death  of  Dr.  Gene  Adams,  the  original  Principal  Investigator, 
occurred  on  March  14,  1992,  just  two  weeks  after  the  initiation  of  this  contract.  This 
report  is  dedicated  to  his  memory. 

ABSTRACT 

In  this  report,  we  present  further  analyses  of  data  taken  during  the  Arecibo  Iniiiadve 
in  Dynamics  of  the  Atmosphere  (AIDA'89)  campaigns,  concentrating  on  the  third 
campaign  (Scene  III)  from  May  2  through  May  9,  1989. The  major  emphasis  is  on  the 
comparison  between  the  MAPSTAR  imaging  Doppler  inierfeiuiiietry  (IDl)  radar  and  the 
Arecibo  Observatory  incoherent  scatter  (ISR)  radar,  but  some  comparisons  with  the 
Geospace  Corporation  meteor  wind  radar  (MWR),  and  the  Arecibo  Observatory  Fabry - 
Perot  spectrometer  (EPS)  are  also  included.  A  reanalysis  of  four  IDI  -  ISR  -  MWR 
comparisons  shows  better  agreement  between  all  three  techniques  than  previously 
reported.  In  general,  we  find  better  agreement  between  the  daytime  radar  winds  than  that 
previously  published  for  the  April  campaign,  with  the  zonal  winds  agreeing  better  than 
the  meridional.  In  contrast,  the  nightime  IDI  -  EPS  comparisons  show  better  agreement  in 
the  meridional  component,  and  considerably  better  agreement  after  midnight  than  before. 

[The  report  consists  of  two  parts  -  Part  1,  in  which  plots  are  presented  and 
discussed,  and  Part  2,  which  details  the  data  reduction  and  analysis  procedures,  and 
contains  listings  of  the  computer  programs  used]. 
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Atmosphere:  Morphology  and  Comparison  of  Techniques"  on  June  28,  1993,  and  is  now 
a  professor  at  the  Air  Force  Academy,  Colorado  Springs,  Colorado. 
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Roper,  R.G.,  G.W.  Adams  and  J.W.  Brosnahan,  "Tidal  winds  at  mesopause  altitudes  over 
Arecibo  (18°N,  67°W),  April  5  -  11,  1989  (AIDA'89)",  J.  Atmos.  Terrest.  Phys.,  289-312, 
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Part  1  -  Results  from  AIDA  Scene  III  -  May  2  -  9, 1993 
IDI  -  ISR  Comparisons 


Since  the  submission  of  the  papers  published  in  the  AIDA  Special  Issue  of  the 
Journal  of  Atmospheric  and  Terrestrial  Physics  in  March,  1993.  some  of  the  analysis 
criteria  for  both  the  Arecibo  Observatory  incoherent  scatter  (ISR)  and  MAPSTAR 
imaging  doppler  interferometry  (IDI)  radars  have  been ‘changed. This  is  illustrated  in  the 
results  of  the  IDI  -  ISR  -  meteor  wind  radar  (MWR)  comparisons  presented  in  Figure  la- 
d,  the  same  intervals  as  plotted  in  Figure  5  of  Hines  et  al.  (1993).  We  have  here  included 
results  from  not  only  the  393°  azimuth  soundings,  but  also  those  at  303°  azimuth  (note 
that  the  velocities  at  these  azimuths  are  the  line  of  sight  at  1 1.3°  zenith  angle),  and  the 
zonal  and  meridional  components  inferred  from  these  measurements.  Note  that,  unlike 
the  Hines  et  al.  plots,  the  IDI  results  have  been  produced  by  projecting  the  IDI  three 
dimensional  wind  vector  onto  the  ISR  lines  of  sight  and  then  using  the  resultant 
projections  into  the  horizontal  to  calculate  the  zonal  and  meridional  wind  velocities.  This 
parrallels  the  ISR  reduction,  which  considers  the  vertical  wind  to  be  zero  when  producing 
the  horizontal  projections.  Also  plotted  are  the  velocity  components  inferred  from  a 
Groves  analysis  of  the  IDI  data,  fitting  mean,  diurnal  and  semidiurnal  components  to  the 
IDI  scattering  point  parameters  for  each  24  hours  (from  noon  to  noon)  of  the  campaign. 
These  are  plotted  as  IDIG. 

The  next  section  concentrates  on  the  reduction  and  analysis  of  the  May  2-9,  1989 
IDI  -  ISR  comparisons.  Figures  2  through  33  are  similar  plots  to  those  presented  in  Figure 
1  (but  note  that  no  MWR  data  is  available  for  these  intervals).  Instead  of  the  two  hour 
intervals  published  in  Hines  et  al.  (1993)  and  Roper  et  al.  (1993),  the  intervals  used  here 
span  some  43  minutes,  with  the  ISR  radar  integrating  data  for  some  25  minutes  at  the 
393°  (123°)  azimuth,  and  for  1 1  minutes  at  the  303°  (213°)  azimuth,  with  six  to  seven 
minutes  spent  in  moving  the  gondola  to  change  the  viewing  azimuth.  The  IDI  data  has 
been  averaged  for  the  total  43  minutes  -  the  11  minute  timeslot  is  marginal  for  IDI  wind 
profile  determination,  although  the  25  minute  line  of  sight  measurements  have  been 
subject  to  closer  scrutiny  and  will  be  published  in  Turek  et  al.  (1993). 

We  are  in  the  process  of  interpreting  these  results.  Of  interest  is  the  apparently 
better  agreement  between  the  IDI  and  ISR  velocities  in  the  zonal  (and  303°  and  123° 
azimuths  -  those  closer  to  the  east  -  west  direction)  than  the  meridional  (and  393°  and 
213°  azimuths).  This  warrants  further  investigation. 
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IDI  -  FPS  Comparisons 

In  this  section,  we  present  a  preliminary  look  at  six  additional  IDI  -  FPS 
comparisons  not  included  in  the  Hines  et  al.  (1993)  paper,.  The  FPS  data  used  here  is 
from  the  Arecibo  Radio  Observatory  Fabry-Perot  Sp)ectrometer  as  published  in  Bird  et  al. 
(1993). 

In  contrast  to  Hines  et  al.,  who  compared  the  FPS  data  with  the  IDI  winds  at  94,  97 
and  100km,  we  follow  the  method  of  Hernandez  and  Roper  ( 1979),  who,  in  comparing 
meteor  radar  and  FPS  winds,  smoothed  the  meteor  radar  wind  profiles  with  a  green  line 
profile  to  produce  height  averaged  wind  values.  The  smoothing  profile  used  here  weights 
the  IDI  data  from  93  to  102km  with  the  function  graphed  in  Figure  34  (a  gaussian  of  7km 
half-width  centered  on  97km). 

The  FPS  data  was  collected  by  stepping  the  spectrometer  around  eight  cardinal 
points  whose  intersection  with  the  97km  altitude  level  defined  a  circle  of  radius  170km, 
across  which  the  line  of  sight  drifts  are  averaged  (allowing  for  a  linear  gradient  with 
separation)  to  produce  a  horizontal  wind  vector  every  2 1  minutes.  The  IDI  scattering 
point  parameter  data  (which  are  confined  by  rhe  transmitter  beamwidth  to  a  circle  of 
radius  20km  at  97km)  were  analysed  in  21  minute  segments  to  produce  altitude  profiles 
which  were  then  smoothed  with  the  green  line  weighting  function.  We  have  not  used  the 
Hines  et  al.  "discrepancy  line"  representation,  but  rather  have  shown  our  results  in 
Figures  35  through  37  as  zonal  and  meridional  wind  plots.  We  have  also  plotted  the  green 
line  smoothed  Groves  winds  (prevailing  plus  diurnal  plus  semidiurnal  fits  to  the  IDI 
data)  for  comparison. 

Again,  we  have  spent  little  time  on  the  interpretation  of  these  results.  However,  the 
IDI  and  FPS  winds  do  show  better  agreement  in  the  meridional  than  they  do  in  the  zonal 
(see  Figure  38),  which  is  just  the  opposite  of  the  IDI  -  ISR  comparisons!  Of  interest  also 
is  the  considerably  better  agreemen  t  between  the  IDI  and  FPS  winds  after  {X)30  hours. 
The  velocity  differences  are  a  factor  of  two  smaller  after  0030hrs  than  before  (see,  again. 
Figure  38).  One  might  speculate,  given  the  high  shear  with  height  of  the  IDI  winds,  that 
the  green  line  maximum  emmission  altitude  is  not  constant,  at  least  before  midnight.  The 
solution  is  not  that  simple,  however.  The  results  from  the  night  of  May  3  -  4  (Figure  36) 
compare  well  throughout  the  night  in  the  meridional  component,  and  in  the  zonal 
component  after  midnight,  but  disagree  by  some  lOOm/s  in  the  zonal  at  20  -  2100hours! 
Obviously,  these  results  warrant  further  investigation. 
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FIGURE  38 
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Part  2  -  The  MAPSTAR  Imaging  Doppler  Interferometry  (IDI)  radar 
Data  Reduction  and  Comparative  Analysis 
Computer  Programs. 

This  second  part  of  this  two  part  report  outlines  the  procedures  to  produce  the  data 
tables  and  graphs  presented  in  Part  I . 

The  first  section  deals  with  the  reduction  and  analysis  procedures  developed  by 
Gene  Adams  and  used  by  him  and  his  students  to  reduce  and  analyse  the  MAPSTAR 
radar  data  at  Utah  State  University.  Input  data  are  the  digitized  raw  signal  tapes  (for  the 
purposes  of  this  report,  those  recorded  as  the  outputs  of  each  of  the  MAPSTAR  radar 
receivers  during  AIDA  Scene  III  -  May  2-9,  1989,  but  applicable  to  any  interval).  Data 
was  recorded  in  this  form  so  that  it  could  be  subsequently  analysed  using  algorithms 
appropriate  to  other  partial  reflection  interferometry  and  spaced  antenna  techniques.  The 
results  of  such  other  analyses  are  part  of  currently  proceeding  analyses,  and  will  be 
reported  later.  Here,  we  concentrate  on  the  Imaging  Doppler  Interferometry  (IDI) 
analysis,  details  of  which  may  be  found  in  Brosnahan  and  Adams  (1993). These  programs, 
written  in  IBM  PC  compatible  FORTRAN  77,  determine  the  individual  scattering  point 
parameters  (time  of  occurrence,  height,  line  of  sight  velocity,  azimuth  and  zenith  angles 
and  polarization  of  return)  and  use  these  to  determine  hourly  mean  zonal,  meridional  and 
vertical  wind  profiles,  wjth  errors,  over  selected  height  ranges.  A  detailed  writeup  of 
these  procedures,  produced  by  Gene  only  two  months  before  his  death,  follows. 
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process2 .mem 


To:  Files 

From:  Gene  W.  Adams 

Subject:  Explanation  of  GR-AIDA  Tape  Processing 

This  documentation  initially  follows  a  20-point  check  list  I 
made  for  myself.  This  memo  will,  I  hope,  explain  enough  of  what's 
going  on  to  get  you  through  it.  There's  more  after  the  20-point 
list,  but  it's  not  crucial  (you  could  redo  the  software  if  you  had 
to)  . 


Processing  a  tape  on  an  IBM-PC  involves  reading  the  original 
raw-data  9-track  tape,  separating  and  somehow  storing  the 
information  in  the  tape  and  record  headers  and  the  associated 
strings  of  data,  inverting  the  byte  order  of  the  data  (program 
named  GAFIX.for),  putting  the  data  through  a  4-pass  filter  (program 
named  FLTRB.for)  to  remove  spikes,  removing  the  dc  components  of 
the  signal,  adjusting  all  10  channels  to  have  common  gain,  and 
correcting  the  phases  of  the  10  channels.  The  "calibrated"  data 
are  stored  on  dat  and  erasable  optical  (EO)  disks,  and  on  9-track 
tape  as  needed  to  satisfy  requests  from  others  that  want  to  reduce 
our  data  with  their  algorithms  (Joel  Van  Baelen  and  Erhan  Kudeki, 
so  far)  .  The  IDI  algorithms  are  then  used  (program  named 
BSPPM.for)  to  determine  the  scattering-point  parameters  (SPPs)  from 
the  calibrated  data.  The  bulk  of  the  processing  sequence  can  be 
done  from  a  batch  file  (batch  file  named  MOJO.bat),  but  manual 
intervention  is  still  needed  to  identify  tape-write  errors,  enter 
the  tape  number,  etc.  That's  why  my  check  list  is  long. 

The  quoted  command  at  each  number  is  from  my  20-point  check 

list: 

1.  "Boot  up  with  \final  disk  in  EO  drive."  An  erasable-optical 
disk  with  a  \ final  directory  is  where  I  collect  the  scattering- 
point  parameter  files  for  the  tape  just  processed.  They  carry  the 
time  of  each  sounding  (102.4sec/sounding)  followed  by  the  SPPs, 
ordered  by  altitude,  lowest  altitude  first. 

2.  "Open  and  close  Windows."  Opening  and  closing  Windows  3.0 
seems  to  be  required  on  my  system  to  get  the  cursor  to  go  fast. 
Otherwise,  it's  slow. 

3.  "Delete  all  files  in  \Buffer01  and  \Buffer02."  \Buffer01  and 
\Buffer02  are  two  subdirectories  on  the  C:  drive,  each  big  enough 
to  hold  a  tape's  worth  of  data.  Since  the  filter  processes  an 
entire  tape  at  once,  the  tape  in  its  various  stages  of  processing 
are  written  from  \Buffer01  to  \Buffer02,  back  to  \Buffer0l,  etc., 
until  it's  done.  It  starts  with  the  raw  data  in  \Buffer01,  and 
finishes  with  the  calibrated  data  in  \Buffer02. 


4.  "Mound  and  load  raw  data  tape  on  9-track  drive."  An  original 
data  tape  should  never  be  read  but  once.  They're  far  too  precious 
and  irreplaceable  to  do  anything  but  immediately  make  a  back-up. 
This  is  where  we  make  the  back-up, 

5.  "Put  up  post-it  with  tape  number  on  it."  The  tape  number 
(e.g.,  GR-235)  is  not  automatically  entered  anywhere,  so  keep 
careful  track  and  you  can  enter  it  in  the  appropriate  place  below. 

6.  "Run  TapetoC.bat,  which  read  tape  files  into  c:\Buffer01."  A 
copy  of  TapetoC.bat  is  attached.  It's  pretty  simple,  and  names  the 
files  as  read  in  as  l.mbr,  2.mbr,  etc.  The  extensions  are  used  to 
label  the  type  of  file.  The  first  letter  is  m  for  medium  frequency 
(the  MAPSTAR  radar)  or  v  for  vhf  (the  MENTOR  radar) .  The  second 
letter  is  b  for  binary  or  a  for  ascii.  The  third  letter  is  r  for 
raw  data,  t  for  time-domain-average  (calibrated)  data,  etc. 

7.  "Invoke  DAT  software  with  C:>tpu  -<return>,  then  FSFnn  at  the  - 
prompt  to  advance  DAT  nn  files  to  end."  This  assumes  that  you're 
putting  the  calibrated  data  tapes  on  a  DAT  tape,  and  that  you've 
already  got  some  files  on  the  tape.  This  command  just  moves  the 
DAT  tape  to  the  end  of  the  nn  files  you've  already  got,  and  leaves 
it  ready  to  record  the  next  tape's  worth  of  files  (there's  usually 
46-50  files  per  tape) . 

8.  "Examine  \Buffer01;  note  odd-length  files."  If  there  was  a 
tape-write  error  during  the  radar  operation,  you'll  get  a  file 
that's  longer  than  all  the  others,  because  two  files  get 
transmogrified  into  one.  You  want  to  skip  these  files,  and  can 
erase  them  if  it  seems  better. 

9.  "Edit  FixTape.bat  to  skip  odd-length  raw-data  files." 
FixTape.bat  (attached)  invokes  the  fortran  program  GAFix.for  (copy 
attached,  along  with  subroutines  RdHdr.for,  Names. for,  and 
WrHdr.for)  to  separate  the  data  from  the  ascii  header  information, 
and  write  the  byte-inverted  data  to  \Buffer02  (which  can  be  changed 
in  the  source  code,  where  it  is  named  "pathout".)  FixTape.bat  can 
be  made  to  skip  file  number  29,  for  instance,  by  just  putting  a 
"goto  30"  right  before  :29.  Notice  that  it  uses  drive  E; ,  which  is 
my  ram  drive.  Change  this  to  whatever  drive  you  have  available  so 
that  GAFix  has  a  place  to  work  (it  needs  room  for  2  copies  of  a 
single  data  file:  less  than  2  Mbytes. 

10.  "Edit  MOJO.bat  to  write  properly  named  files."  MOJO.bat,  in 
step  number  5,  names  the  list  of  sounding  times  (contianed  in 
gafix.txt)  and  the  SPPs  (contianed  in  bsppm.mbs)  according  to  the 
tape  number  (the  GR  number) .  It  is  entered  manually  at  this  point 
by  editing  MOJO.bat. 

11.  "Fill  up  paper  tray."  It  takes  about  half  a  tray  of  paper  if 
you're  going  to  image  the  screen  so  you  can  tell  if  it  all  worked 
once  you're  done.  It  can  make  a  catastrophic  mistake  and  return 
you  pure  garbage,  and  if  you  haven't  been  monitoring  the  screen  you 
probably  won't  know  about  it. 


12.  "Turn  on  screen  copy."  Cntrl-P  toggles  the  print-screen 
command.  Hit  it  again  when  you're  all  done. 

13.  "Run  Mojo.bat  (takes  about  4hr  40min)." 

13A.  "Copy  raw  files  from  \Buffer01  to  DAT  {45min)."  This  gets  a 
true  back-up  of  the  original  data  tape  onto  DAT.  We  will  also  save 
the  calibrated  tape,  but  just  in  case  you  ever  want  to  change  the 
calibration  procedure... 

13B.  "Run  FixTape . Bat" .  As  explained  above,  this  separates  data 
from  header  info  and  inverts  the  byte  order  (if  selected  by  a 
switch  in  the  source  code) .  An  entire  tape  is  processed,  and  the 
finished  files  written  to  \Buffer02.  The  file  names,  which  carry 
the  time  of  the  sounding  to  the  second,  have  been  written  to 
gafix.txt.  The  format  is  MMDDHHMM.SSt  where  MM  =  month,  DD  =  day, 
HH  =  hour,  MM  =  minute,  SS  =  second,  and  t  denotes  calibrated  time- 
domain  data.  Example:  04281345. 17t.  Time  is  corrected  to  WWV  and 
to  the  center  of  the  sounding,  so  time  span  is  +/-  102.4/2sec 
around  given  time.  The  tape-header  and  sounding-header  is  read  by 
GAFix,  but  is  not  handled  by  the  software  beyond  this.  You  have  to 
edit  the  header.dat  file  for  each  run.  However,  the  time  is  kept 
by  the  name  of  the  file,  and  generally  nothing  else  changes,  so 
this  works  out  okay. 

13C.  "Run  FltrB.exe."  FltrB.for  is  attached,  as  are  the 
subroutines  FltrBl.for,  FltrB2.for,  FltrB3.for,  and  FltrB4.for. 
The  batch  file  (Mojo.bat)  copies  the  list  of  file  names,  which  are 
also  the  times,  from  gafix.txt  to  FltrB.txt.  FltrB.for  just  keeps 
the  file-names  straight  and  the  buffers  straight,  and  calls  the 
four  subroutines.  FltrBl.for  makes  one  pass  through  the  tape  to 
determine  the  dc  average  for  each  of  the  20  channels,  a  second  pass 
to  determine  the  rms  deviation  of  the  averaage,  and  a  third  pass  to 
recalculate  the  dc  average  excluding  points  whose  deviation  from 
the  average  is  more  than  3  sgima.  A  fourth  pass  is  made  to 
subtract  the  dc  average  from  the  data  in  each  channel.  FltrB2 
removes  noise  burts,  defined  as  single  data  points  that  are  20(?)dB 
or  more  above  the  running  a\erage.  FltrB3  calculates  the  average 
power  in  each  of  the  20  channels.  FltrB4  adjusts  the  signal 
strength  in  each  of  the  20  channels  so  that  they  all  have  the  same 
average  power,  and  the  phases  are  adjusted  relative  to  the  x- 
quadrature  channel  of  antenna/receiver  #5,  which  is  used  as  the 
phase  reference) .  The  phase  corrections  were  determined  by 
averaging  over  2+  hours  of  solid  daytime  E  region,  and  assuming 
that  the  echoes  were,  on  the  average,  in  the  zenith.  This  clearly 
needs  to  be  repeated  and  several  episodes  averaged  to  get  better 
numbers . 

13D.  "Run  Bsppm.exe."  B  is  for  batch  and  m  is  for  medium- 
frequency.  This  will  need  rewriting  when  the  MENTOR  data  comes  in, 
but  it's  all  in  one  subroutine  and  it's  easy.  The  screen  displays, 
one  sounding  at  a  time,  the  number  of  scattering  points  found  at 
each  altitude  and  the  number  rejected  by  the  various  criteria.  The 
program  is  Bsppm.for,  with  subroutines  BfftM.for  (the  FFT  driver), 
FFT2cm.for  (the  FFT  routine  itself).  Header  (which  reads 


header.dat,  an  ascii  file  that  contains  all  the  radar  settings,  and 
which  you  construct  out  of  the  existing  one  edited  to  be  accurate 
for  whatever  you're  doing),  BtestM.for  (which  applies  the  IDI 
algorithms  to  see  if  a  particular  spectral  window  at  a  particular 
altitude  is  a  scattering  point  or  not),  BSteerM.for  (which  steers 
the  array  towards  scattering  points  to  get  the  best  estimate  of 
their  amplitudes  and  phases),  and  BSortM.for  (which  orders  the 
scattering  points  by  altitude,  ready  for  output) .  The  SPPs  are 
written  in  binary  to  a  file  called  BSppM.mbs  (m  =  medium-frequency; 
b  =  binary;  s  =  scattering-poing  parameters) .  Notice  that  this  one 
•mbs  file  contains  the  SPPs  for  the  entire  tape;  the  format  is  a 
10-numbered  time  line  (first  number  is  -999)  followed  by  many  10- 
numbered  lines  of  SPPs.  These  are:  altitude,  radial  velocity,  E-W 
zenith  angle,  N-S  zenith  angle,  E-W  amplitude,  E-W  phase,  N-S 
amplitude,  N-S  phase,  E-W  zentih-angle  window  (from  BSppm,  Btest2. 
This  measures  the  noisiness  of  the  scattering  point) ,  and  N-S 
zenith-angle  window.  The  rest  of  my  programs  (like  for  winds) 
don't  work  until  you've  put  these  SPP  strings  through  a  program 
(discussed  later)  that  will  gather  them  into,  say,  30min  intervals, 
then  reorder  them  by  altitude. 

13E.  "Copy  gafix.txt  and  bsppm.mbs  to  D:\final."  I  kept  a  copy  of 
each  gafix.txt  (list  of  sounding  times)  and  the  SPPs  in  BSppM.mbs 
(renamed  to,  say,  GR245.txt  and  GR245.mbs)  on  my  hard  drive,  as 
well  as  backing  them  up  to  both  DAT  and  EO  later  on.  Be  sure  you 
rename  the  files  so  that  you  have  them  named  by  the  AIDA  tape 
number. 

13F.  "Copy  gafix.txt,  \Buffer02  files,  and  BSppm. mbs  to  DAT."  I 
backed  up  the  SPPs,  the  file  names,  and  the  calibrated  tap  (which 
is  in  \Buffer02  at  this  point)  to  DAT.  Bookkeeping  is  miserable; 
needs  a  better  system  than  mine.  Sure  is  handy  and  fast  to  recover 
from  DAT  though. 

13G.  "Run  SppMoxl  on  bsppm.mbs."  The  most  useful  tape-at-a-time 
diagnostic  I  have  found  is  to  plot  the  radial  velocity  vs  altitude 
for  all  the  scattering  points,  separately  for  the  ordinary, 
extraordinary,  and  linear  modes.  SppMoxl. for  will  separate  the 
tape-files  SPPs  into  O,  X,  and  L  for  plotting. 

14.  "Turn  off  screen  copy."  The  screen  output  to  this  point  is 
fairly  condensed  and  makes  a  good  diagnostic;  you  should  survey  it 
carefully  to  ensure  that  the  entire  processing  went  sensibly  (you 
got  no  error  messages  during  FltrB;  you  got  scattering  points  where 
you  expected  them  in  BSppM,  etc.) 

15.  "Print  gafix.txt."  I  keep  the  list  of  files  (which  are  the 
sounding  times)  as  part  of  my  hard-copy  documentation  on  each  tape; 
the  plots  of  O,  X,  and  L  are  the  rest  of  it. 

16.  "Edit  Sppm21o.grf,  Sppm21X.grf,  and  Sppm21L.grf . '  I  had  to 
enter  the  tape  number  and  the  times  onto  each  graph  (3  per  tape) 
manually  by  editing  the  Golden-Graphics  .grf  file.  It's  pretty 
fast,  but  I'm  sure  there  are  better  ways. 
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17.  "Run  PlotOXL.bat  to  generate  3  "21”  plots."  A  21  plot  is  SPP 
#2  (radial  velocity)  on  the  abscissa  and  #1  (altitude)  on  the 
ordinate.  These  three  plots  and  the  list  of  files  are  the  hard¬ 
copy  documentation  I  keep  on  each  tape.  (See  Brosnahan  and  Adams, 
1992,  for  samples  of  these  polarization-filtered  plots.) 

18.  "Update  DatLog.txt."  Since  the  DAT  tapes  require  external 
bookkeeping,  this  is  where  I  do  it,  on  a  one-page  list  (attached) 
called  DatLog.txt.  There's  got  to  be  a  better  way  than  this. 

19.  "Reboot  with  propper  10-tape  disk  in  EO  drive."  I  store  10 
calibrated  tapes  and  the  associated  SPP  files  on  EO  disks. 
Overkill. 

20.  "Copy  \Buffer02,  gafix.txt,  and  Bsppm.mbs  to  EO."  But  I  do 
it  anyhow. 

Now  the  SPPs  are  in  a  format  that  is  sounding  time  (10  4-byte 
words)  followed  by  n  SPPs  (n  lines  of  10  4 -byte  numbers) .  I  have 
a  program  called  SGroup.for  (subroutines  SName.for,  SMerge.for,  and 
BellSub.for,  which  rings  the  bell  a  few  times  when  the  program  is 
finished — it  can  be  a  slow  program)  that  will  read  through  a  series 
of  GRxxx.mbs  files,  group  them  into  user-specified  intervals  (e.g. 
lOmin,  2hour,  etc.),  and  reorder  them  by  altitude.  This  makes  it 
a  lot  faster  for  wind  calculations,  but  if  I  were  doing  it  over, 
I'd  let  the  wind  program  make  multiple  passes  instead.  This 
program  is  too  complicated,  and  I've  had  trouble  with  it  lately 
(the  SPPs  would  come  out  close  to,  but  not  always  exactly,  ordered 
by  altitude.  Usually  the  error  would  be  a  fraction  of  a  km; 
sometimes  I'd  find  a  40km  point  up  around  90km.)  The  program  is 
designed  to  take  a  variety  of  inputs,  but  it's  really  hacked 
together.  Sorry. 

There  are  two  versions  of  the  wind-calculation  program 
available.  These  are  WindErr.for  (subroutines  SppFltr.for, 
Header. for,  WFV.for,  and  WFH.for)  and  Wind. for  (subroutines 
inName.for,  outName.for,  Header. for,  WFV.for,  WFH.for,  and 
PhFit.for).  (WFV  =  Wind-Fit,  Vertical;  WFH  =  Wind-Fit, 
Horizontal.)  The  first  will  do  the  129  repeats  of  the 
calculations,  with  each  variable  (radial  velocity,  altitude, 
horizontal  location)  taking  on  its  extreme  values.  This  is  done  to 
determine  the  error  bars  due  to  calculational  uncertainty.  The 
second  program  uses  just  the  nominal  values  for  the  input 
parameters  to  calculate  the  wind  profile,  but  also  calculates  the 
components  (sort  of)  of  the  velocity  variance  vector.  This  was 
just  getting  developed,  so  it  will  take  some  work.  Probably  best 
to  junk  my  calculation  and  do  it  right.  I  don't  do  an  actual  fit 
to  the  perpendicular  and  parallel  components  of  the  velocity 
variance  vector,  but  count  them  only  if  they're  within  90  degrees 
(binary  sorting) .  Works  okay,  but  needs  to  be  a  full  fit  (which 
looks  easy)  before  you  do  anything  with  the  velocity  variance 
vectors  (which  I'm  sure  carry  all  the  information  there  is  about 
the  breaking  waves) . 


52 


copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 

copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 

copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 

copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 

copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
copyin  c 
rew/unl 


.  r  i ' '' 


cn  1 


:  \buf fer01\l . mbr/b : 16384 
:  \buf fer01\2 . mbr/b : 16384 
;  \buffer01\3 .mbr/b : 16384 
;  \buf fer01\4 . mbr/b ; 16384 
;\buffer01\5 .mbr/b : 16384 
:  \buf f er01\6 . mbr/b ; 16384 
:  \buf f er01\7 . mbr/b : 16384 
;  \buf f er01\8 . mbr/b ; 16384 
:  \buf fer01\9 . mbr/b ; 16384 
:  \buf fer01\10 . mbr/b ; 16384 

:  \buf fer01\ll . mbr/b : 16384 
:  \buf f er01\12 . mbr/b ; 16384 
:  \buf f er01\13 . mbr/b : 16384 
;  \buf f er01\14 . mbr/b : 16384 
;  \buffer01\15 . mbr/b ; 16384 
:  \buf f er01\16 . mbr/b : 16384 
:  \buf f er01\17 . mbr/b ; 16384 
:  \buffer01\18 .mbr/b : 16384 
;  \buf fer01\19 . mhr/h : 16384 
:  \buffer01\20 .mbr/b ; 16384 

:  \buffer01\21 .mbr/b : 16384 
:\buffer01\22. mbr/b: If 384 
:  \buf fer01\23 .mbr/b : 16384 
:  \buf fer01\24 . mbr/b : 16384 
:  \buf fer01\25 . mbr/b : 16384 
;  \buffer01\26 .mbr/b : 16384 
:  \buf f er01\27 . mbr/b : 16384 
:  \buffer01\28 .mbr/b : 16384 
:  \buf f er01\29 . mbr/b : 16384 
:  \buf fer01\30 . mbr/b : 16384 

;  \buffer01\31 . mbr/b : 16384 
:  \buf f er01\32 .mbr/b : 16384 
;  \buffer01\33 .mbr/b : 16384 
;  \buf f er01\34 .mbr/b ; 16384 
:  \buf fer01\35 . mbr/b : 16384 
:  \buf fer01\36 . mbr/b ; 16384 
;  \buf f er01\37 . mbr/b : 16384 
:  \buf fer01\38 . mbr/b : 16384 
; \buf fer01\39 . mbr/b ; 16384 
: \buf fer01\40 . mbr/b ; 16384 

:  \buffer01\41 .mbr/b : 16384 
; \buff er01\42 . mbr/b : 16384 
: \buffer01\43 .mbr/b : 16384 
: \buf fer01\44 . mbr/b ; 16384 
; \buffer01\45 . mbr/b : 16384 
: \buf fer01\46 . mbr/b : 16384 
\buf fer01\47 . mbr/b : 16384 
: \buf f er01\48 . mbr/b : 16384 
: \buf fer01\49 . mbr/b : 16384 
: \buf fer01\50 . mbr/b : 16384 
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MOJO . BAT 


:1  This  copies  the  calibrated  SPP  data 

cd  \Buffer01 

tpu  dt  dfs  tfs  bll6384  dn"*.*” 

cd  \work  the  DAT 

;2 

;  FixTape  runs  GAFix  on  the  .mbr  files  in  BufferOl,  and  puts 
;  the  fixed  files  into  Buffer02.  Data  file  names  are  in 
:  gafix.txt. 

Call  FixTape 

:3 

;  FltrB  does  the  dc  removal  and  phase  correction  for  the  list  of 
:  files  in  FltrB.txt.  The  filtered  files  are  written  to  Buffer02 . 
del  \Buffer01\*.mbr 
copy  gafix.txt  FltrB.txt 
FltrB 

;4 

:  BsppH  runs  the  SPP  program  on  the  list  of  files  in  BsppM.txt, 

:  which  is  the  same  as  gafix.txt. 

copy  gafix.txt  BsppM.txt 

BsppM 

:5 

copy  gafix.txt  d;\final\gr215 . txt 
copy  bsppm.mbs  d:\final\gr215.mbs 

:6 

tpu  dt  dfs  tfs  bll6384  dn"gafix. txt" 
cd  \Buffer02 

tpu  dt  dfs  tfs  bll6384  dn"*.*" 
cd  \work 

tpu  dt  dfs  tfs  bll6384  dn"bsppm.mbs" 

:7 

sppmoxl  bsppm.mbs 
;8 

sppmchk  bsppm.mbs 
Bell 


time 


FIXTAPE.BAT 


del  gaflx.txt 
echo  off 

:2 

copy  \buf fer01\2 . mbr  erx.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

:3 

copy  \buf fer01\3 . mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r4 

copy  \buffer01\4 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r5 

copy  \buffer01\5 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r6 

copy  \buffer01\6 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

:7 

copy  \buffer01\7 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r8 

copy  \buffer01\8 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

:9 

copy  \buf fer01\9 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

rlO 

copy  \buffer01\10.mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

rll 

copy  \buffer01\ll .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

rl2 

copy  \buffer01\12 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 


rl3 


copy  \buf fer01\13 .mbr  erx.mbr 
gafix  e.x.mbr 
del  eix.mbr 

;14 

copy  \buffer01\14 . mbr  e:x.mbr 
gafix  e:x.mbr 
del  e.x.mbr 

:15 

copy  \buffer01\15 . mbr  e;x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:16 

copy  \buffer01\16 .mbr  e;x.mbr 
gafix  e;x.mbr 
del  e:x.mbr 

;17 

copy  \buffer01\17 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:18 

copy  \buffer01\18 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:19 

copy  \buffer01\19 .mbr  erx.mbr 
gafix  e;x.mbr 
del  e:x.mbr 

;20 

copy  \buffer01\20 .mbr  e;x.mbr 
gafix  e:x.mbr 
del  e.x.mbr 

:21 

copy  \buffer01\21.mbr  e:x.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

:22 

copy  \buffer01\22 .mbr  e;x.mbr 
gafix  e'.x.mbr 
del  e:x.mbr 

:23 

copy  \buffer01\23.mbr  e.x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:24 

copy  \buffer01\24 . mbr  e:x.mbr 
gafix  e.x.mbr 
del  e;x.mbr 

:25 
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copy  \buf fer01\25 . mbr  e;x.mbr 
gafix  e.x.mbr 
del  e;x.mbr 

;26 

copy  \buf fer01\26 , mbr  e.x.mbr 
gafix  eix.mbr 
del  e:x.mbr 

:27 

copy  \buffer01\27 . mbr  erx.mbr 
gafix  e;x.mbr 
del  e.x.mbr 

-.28 

copy  \buffer01\28 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

:29 

copy  \buffer01\29 . mbr  e;x.mbr 
gafix  e.x.mbr 
del  e:x.mbr 

:30 

copy  \buffer01\30 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

;31 

copy  \buffer01\31 .mbr  erx.mbr 
gafix  e;x.mbr 
del  e:x.rabr 

:32 

copy  \buffer01\32 .mbr  e:x.mbr 
gafix  e;x.mbr 
del  e:x.mbr 

;33 

copy  \buffer01\33 . mbr  e:x.mbr 
gafix  e:x.mbr 
del  e'.x.mbr 

:34 

copy  \buffer01\34 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

:35 

copy  \buffer01\35  .mbr  e’.x.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

:36 

copy  \buffer01\36 .mbr  e;x.mbr 
gafix  e;x.mbr 
del  e:x.mbr 


copy  \buffer01\37 . mbr  e;x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:38 

copy  \buffer01\38 .mbr  erx.mbr 
gafix  e.x.mbr 
del  e:x.mbr 

;39 

copy  \buffer01\39 .mbr  e:x.mbr 
gafix  e.x.mbr 
del  e.x.mbr 

:40 

copy  \buffer01\40 . mbr  e:x.mbr 
gafix  e:x.mbr 
del  e.x.mbr 

:41 

copy  \buffer01\41 . mbr  erx.mbr 
gafix  e:x.mbr 
del  e:x.mbr 

;42 

copy  \buffer01\42 .mbr  e:x.mbr 
gafix  e:x.mbr 
del  e;x.mbr 

:43 

copy  \buffer01\43 .mbr  e;x.mbr 
gafix  e:x.mbr 
del  erx.mbr 

:44 

copy  \buffer01\44.mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r45 

copy  \buffer01\45 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r46 

copy  \buffer01\46 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r47 

copy  \buffer01\47 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

r48 

copy  \buffer01\48 .mbr  erx.mbr 
gafix  erx.mbr 
del  erx.mbr 

-.49 
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copy  \buf ferOL\49  . mbr  e  :x.n;br 
gafix  eix.mbr 
del  eix.mbr 

:  50 

copy  \buf fer0L\50 . mbr  eix.mbr 
gafix  eix.mbr 
del  e;x.mbr 

•*■***•*** 

goto  51 
******* 

:51 


59 


60 


c 


.  C'J. 


§Debug 

c 

program  GAFix 
c 

**************************************************************************** 


*  * 

*  IDI  Radar  Utility  Program  * 

*  Copyright  1990,  Holodyne  Limited  1986  * 

*  All  Rights  Reserved  * 

*  March  2.  1991  * 

*  * 


********************************************************************** 

c 

c 

c  This  program  takes  a  data  file  from  a  MAPSTAR  tape  and  creates 
c  two  files:  a  binary  data  files  and  an  ascii  header  file, 
c  Some  information  for  the  header  file,  such  as  the  "TapeLabel" , 
c  must  be  user -input. 

c  The  data  file  inverts  the  byte  order  for  PCs,  if  selected, 
c  Data  files  are  named  by  the  date  and  time  of  each  file: 
c  YYMMHHMM.SSt.  Each  header  file  is  written  to  a  YYHHMM.SSh 
c  file  and  also  to  "Header. Dat" .  The  raw-data  input  file  is  specified 
c  by  the  user  on  the  command  line.  "Pathout"  is  a  character*12 
c  variable  that  specifies  the  DOS  path  to  the  time-named  output 
c  files.  Header.dat  is  written  to  the  default  drive, 
c 

c  GAFix  calls  RdHdr,  Names,  and  WrHdr 
$ Include; 'GAFix. inc' 

$ Include: 'Header. inc' 
c 

c  Invert  is  a  flag  for  byte  inversion.  Set  Invert-0  for 
c  sensible  computers;  -1  for  PCs. 
c 

icount  -  0 
Invert  -  1 

pathout  -  'c;\buffer02\' 

open  (l.file-'  ', status-' old' , form- ' binary ' ) 
c 

c  Read  the  header  info 
c 

read  (1)  (hdr ( i) . i-1 , 512) 
c 

c  FixHdr  will  extract  from  hdr  all  the  radar-operating  parameters, 
c 

Call  RdHdr 
icount  -  icount  +  1 

c  write  (*,90001)  icount, year , month , day .hour , minute , second 

90001  format  (lx,i2,'  TIME:  ',6(i2,2x)) 

c 

c  Names  will  generate  the  names  of  the  output  files  from  the  date 
c  and  time  info  in  the  header, 
c 

Cal  1  Names 

c  write  (*,90002)  year .month , day .hour , minute , second 

90002  format  ('  CORRECTED  and  CENTERED  TIME ; ' , 6 ( i2 , 2x) ) 

write  (*,90003)  datafile 

90003  format  ('  FILE  BEING  PREPARED;  ',a24) 
open  (2 , f ile-' gaf ix. txt' ) 
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20101  read  (2 , end— 20102 , fmc=90004)  oldname 
go  to  20101 

90004  format  (a24) 

20102  backspace  (2) 

write  (2,90004)  datafile 
close  (2) 
c 

c  Write  the  Header  file, 
c 

c  open  (3 , file-hdrfile , status-' unknown' ) 

open  ( 3 , f ile— 'GAFix.hdr ' , status-' unknown' ) 

Call  WrHclr 
close  (3) 

c 

c  Read  the  data, 
c 

open  (3 , file— datafile , status-' unknown' , form-' binary ' ) 
PCount  —  0 

c  write  (*,*)  '  ' 

c  write  (*,*)  'PROCESSING  BLOCK  #  ' 
do  10002  iblock-1,52 

c  if  ( (iblock/13)*13  .ne.  iblock)  then 
c  write  (*,90201)  iblock 
c  else 

c  write  (*,90202)  iblock 
c  endif 

90201  format  (lx,i2,\) 

90202  format  (lx, 12) 

read  (1)  ( (data(pulse ,byte) , 

1  byte— 1 ,4) , pulse-1 , 3968) 

PCount  -  PCount  +  3968 
c 

c  If  Invert-1,  invert  the  byte  order, 
c 

if  (Invert  .eq.  1)  then 
do  10001  pulse-1,3968 
hold  -  data(pulse , 1) 
data(pulse , 1)  -  data(pulse ,4) 
data(pulse ,4)  -  hold 
hold  -  data(pulse , 2) 
data(pulse,2)  -  data(pulse , 3) 
data(pulse , 3)  -  hold 

10001  continue 
endif 

c 

c  Write  the  data. 

c 

if  (PCount  .It.  206336)  then 
write  (3)  ( (data(pulse .byte) , 

1  byte-1,4) , pulse-1, 3968) 

read(l)  (hdr(i) , i-1 , 512) 
else 

write  (3)  ( (data(pulse,byte) , 

1  byte-1 ,4) , pulse-1 , 2432 ) 

go  to  20002 
endif 

10002  continue 
20002  close  (1) 


close  (2) 
close  (3) 
close  (4) 
end 
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Subroutine  RdHdr 


c 

*  * 

*  IDI  Radar  Utility  Program  * 

*  Copyright  1991,  Holodyne  Limited  1986  ■> 

*  All  Rights  Reserved 

*  March  1,  1991  * 

*  'k 

**************************■*-*************■******•*■***********-***-*-****> 

C 

c 

c  This  subroutine  takes  a  512 -integer  header  string  and  reads 
c  from  it  the  radar  operating  parameters.  All  parameters  are 
c  converted  to  MRS  on  input . 
c 

c  Link;  GAFix  RdHdr  Names  WrHdr 
$Include: 'GAFix. inc' 

$ Include : ' Header . inc ' 

do  10001  i-1.512 
hdr(i)  -  hdr(i)  -  48 
10001  continue 
c 

c  First  Line  of  Header: 
c 

SoundingNumber  -  hdr(3)*1000  +  hdr(4)*100  +  hdr(5)*10  +  hdr(6) 
Year  -  hdr(14)*10  +  hdr(15) 

Month  -  hdr(16)*10  +  hdr(17) 

Day  -  hdr(18)*10  +  hdr(19) 

Hour  -  hdr(21)*10  +  hdr(22) 

Minute  -  hdr(23)*10  +  hdr(24) 

Second  -  hdr(25)*10  +  hdr(26) 
c  write  (SiteName , 90001)  hdr(i) , i-33 ,46) 

c90001  format  (il) 
c  write  (*,'(al4)')  SiteName 

SiteName  —  'Islote,  P.R.  ' 

DataType  -  '0001' 

DataMode  -  '0003' 

FFTPts  -  hdr(61)*1000  +  hdr(62)*100 
1  +  hdr(63)*10  +  hdr(64) 

c 

c  Second  Line  of  Header: 
c 

Freql  -  hdr(78)*le8  +  hdr(79)*le7  +  hdr(80)*le6 

1  +  hdr(81)*le5  +  hdr(82)*le4  +  hdr(83)*le3 

2  +  hdr(84)*le2  +  hdr(85)*lel  +  hdr(86) 

Freq2  -  hdr(91)*le8  +  hdr(92)*le7  +  hdr(93)*le6 

1  +  hdr(94)*le5  +  hdr(95)*le4  +  hdr(96)*le3 

2  +  hdr(97)*le2  +  hdr(98)*lel  +  hdr(99) 

PulseDuration  -  hdr(104)*le-4  +  hdr(105)*le-5  +  hdr(106)*le-6 

1  +  hdr(107)*le-;  +  hdr(108)*le-8  +  hdr(109)*le-9 

FFTPeriod  -  hdr(115)*le-i-2  +  hdr(116)*le+l  +  hdr(117) 

1  +  hdr(118)*le-l  +  hdr(119)*le-2  +  hdr(120)*le-3 

NumCohAve  -  hdr(125)*le5  +  hdr(126)*le4  +  hdr(127)*le3 
1  +  hdr(128)*le2  +  hdr(129)*lel  +  hdr(130) 


c  Third  Line  of  Header: 
c 

NumRangeGates  *  hdr{136)*lOOO  +  hdr(137)*100 

1  +  hdr(138)*10  +  hdr(139) 

NumRx  “  hdr(144)*10  +  hdr(145) 

PRP  -  hdr(151)*le-2  +  hdr(152)*le-3  +  hdr ( 153 ) ^le -4 

1  +  hdr(154)*le-5  +  hdr(155)*le-6  +  hdr ( 156)*le - 7 

2  +  hdr(157)*le-8  +  hdr(158)*le-9 
c 

c  Offset  is  the  offset  to  the  bottom  of  the  first  range-gate, 
c  This  is  set  by  the  radar  operator,  picked  up  automatically 

c  by  the  system,  and  written  to  the  header.  Offset  in  seconds 

c 

Offset  -  hdr(166)*le-4  +  hdr(167)*le-5  +  hdr ( 168 ) *le - 6 
1  +  hdr(169)*le-7  +  hdr(170)*le-8  +  hdr(171)*le-9 

c 

c  Delay  is  the  equipment  delay.  This  depends  on  pulse  length, 
c  cable  length,  etc.  In  Islote  it  was  7.4km.  This  can 
c  be  entered  by  the  operator  into  the  radar's  header,  but  that 
c  didn't  happen  in  Islote. 
c 

c  Delay  -  hdr(173)*le-4  +  hdr(174)*le-5  +  hdr(175)*le-6 

c  1  +  hdr(176)*le-7  +  hdr(177)*le-8  +  hdr(178)*le-9 

c 

Delay  -  7.4e3 

AltMin  -  Offset*!. 5e8  -  Delay 
c 

c  SS  is  the  sample  (range-gate)  spacing.  'This 
c  is  set  by  the  radar  operator,  picked  up  automatically  by  the 
c  system,  and  written  to  the  header, 
c 

SS  -  hdr(183)*le-4  +  hdr(184)*le-5  +  hdr(185)*le-6 
1  +  hdr(186)*le-7  +  hdr(187)*le-8  +  hdr(188)*le-9 

AltStep  -  SS*1.5e8 
RxAttn  -  0 

RxPolarization  -  'Ll' 
c 

c  Fourth  Line  of  Header 
c 

TxPower  -  100000 
do  10002  i-1,10 
RxMask(l)  -  1 
10002  continue 

TapeLabel  -  'SF030' 

return 

end 


Names . tor 


$Debug 

c 

Subroutine  Names 
c 

********-***********************-****'>'***********->-^-^*-A-*->***-*-i****-A-*-A---t 
*  * 

*  IDI  Radar  Utility  Program  * 

*  Copyright  1990,  Holodyne  Limited  1986  * 

*  All  Rights  Reserved  * 

*  March  1,  1991  * 

*  * 


c  This  subroutine  creates  the  names  for  data  and  header  files 
c  from  the  header  information.  Files  are  named  by  time  at 
c  center  of  the  sounding,  with  clock  correction, 
c  Link;  GAFix  RdHdr  Names  WrHdr 
$Include: 'GAFix. inc' 

$ Inc lude ; ' He  ade  r . inc ' 

dimension  DaysPerMo(12) , DaysInMonth(12) 

character*2  ascmonth , ascday , aschour , ascminute , ascsecond 
real*4  Timecorrection 
real*8  BigTime 

integer*4  DaysPerMonth.DaysInMonth , spermin, sperhr , sperday 
character*!  charl , char2 , char3 

data  DaysPerMonth  /31 , 28 , 31 . 30 ,  31,  30,  31,  31,  30,  31,  30,  31/ 
data  DaysInMonths  /0 , 31 , 59 , 90 , 120 , 151 , 181 , 212 , 243 , 273 , 304 , 334/ 

charl  -  ' . ' 
char2  -  't' 
char3  -  'h' 

spermin  -  60 
sperhr  -  3600 
sperday  -  86400 

TimeCorrection  -  +40 

BigTime  -  Second  +  Minute*spermin  +  Hour*sperhr 
1  +  (Day+DaysInMonths(month) )*sperday 

1  +  FFTPeriod/2  +  TimeCorrection 

do  10002  i-1,11 

If  (BigTime  .It.  DaysInMonths(i+l)*SperDay)  go  to  20001 
10002  continue 

write  (*,*)  'Looks  like  a  New  Year  to  Me!' 
return 

20001  Month  -  i 

BigTime  -  BigTime  -  sperday*DaysInMonths (month) 

Day  -  int(BigTime/sperday) 

BigTime  -  BigTime  -  Day*sperday 
Hour  -  int(BigTime/sperhr) 

BigTime  -  BigTime  -  Hour*sperhr 
Minute  -  int(BigTime/spermin) 
second  -  BigTime  -  Minute+spermin 


87 


c  Correct  for  temporal  wrap-around, 
c 

20002  if  (second  . ge .  60)  then 
Second  =  Second  -  60 
Minute  -  Minute  +  1 

go  to  20002 
endif 

20003  if  (Minute  .ge.  60)  then 
Minute  -  Minute  -  60 
Hour  -  Hour  +  1 

go  to  20003 
endif 

20004  if  (Hour  .ge.  24)  then 
Hour  -  Hour  -  24 

Day  —  Day  +  1 
go  to  20004 
endif 

20005  if  (Day  .gt.  DaysPerMonth(Month) )  then 
Day  -  Day  -  DaysPerMonth(MonCh) 

Month  =•  Month  +  1 

go  to  20005 
endif 

if  (month  .It.  10)  then 

write  (ascmonth, 90001)  'O', month 

90001  format  (al,il) 
else 

write  (ascmonth, 90002)  month 

90002  format  (i2) 
endif 

if  (day  .It.  10)  then 

write  (ascday, 90001)  'O', day 

else 

write  (ascday, 90002)  day 
endif 

if  (hour  .It.  10)  then 

write  (aschour, 90001)  'O', hour 

else 

write  (aschour, 90002)  hour 
endif 

if  (minute  .It.  10)  then 

write  (ascminute , 90001)  'O', minute 

else 

write  (ascminute , 90002)  minute 
endif 

if  (second  .It.  10)  then 

write  (ascsecond, 90001)  'O', second 

else 

write  (ascsecond, 90002)  second 
endif 

write  (datafile , 90003) 

1  pathout , ascMonth, ascDay , ascHour , ascMinute , 


2  char 1 , ascsecond , char2 
write  (hdrfile , 90003) 

1  pathout , ascMonth , ascDay , ascHour , ascMinute , 

2  charl , ascsecond, char3 

90003  format  (24a) 
return 
end 
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♦  .*  _  »w  J  _  ^  — 

»^rnur  *  rvi 

c 

$Debug 

c 

Subroutine  WrHdr 
c 

******************************************************************* 
*  ^ 

*  IDI  Radar  Utility  Program 

*  Copyright  1990,  Holodyne  Limited  1986  * 

*  All  Rights  Reserved  ~ 

*  May  5.  1990 

*  -!r 

C 

c  This  subroutine  writes  the  header  file, 
c  Link;  GAFix  RdHdr  Names  WrHdr 
$ Include; 'GAFix. inc' 

$Include; 'Header. inc' 

write  (3,90001)  SoundingNumber 

90001  format  (lx, i4,20x, 'SoundingNumber' ) 

write  (3,90002)  Year 

90002  format  (lx, i2 ,22x, 'Year' ) 

write  (3,90003)  Month 

90003  format  (lx, i2 , 22x, 'Month' ) 

write  (3,90004)  Day 

90004  format  (lx, 12 ,22x, 'Day' ) 

write  (3,90005)  Hour 

90005  format  (lx, i2,22x, 'Hour' ) 

write  (3,90006)  Minute 

90006  format  (lx, i2 , 22x, 'Minute' ) 

write  (3,90007)  Second 

90007  format  (lx, i2 , 22x, ' Second' ) 

write  (3,90008)  SiteName 

90008  format  ( lx, al4,10x, 'SiteName' ) 

write  (3,90009)  DataType 

90009  format  ( lx , a4 , 20x ,' DataType ' ) 

write  (3,90010)  DataMode 

90010  format  ( lx, a4,20x, 'DataMode' ) 

write  (3,90011)  FFTPts 

90011  format  (lx, i4,20x, 'FFTPts' ) 

write  (3,90012)  Freql 

90012  format  (lx, lPel2 . 5 , 12x, ' Freql  (Hz)') 

write  (3,90013)  Freq2 

90013  format  (lx, lPel2 . 5 , 12x, ' Freq2  (Hz)') 

write  (3,90014)  PulseDuration 

90014  format  (lx , lPel2 . 5 , 12x, ' PulseDuration  (seconds)') 
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write  (3,90015)  FFTPeriod 

90015  format  ( lx , lPel2 . 5 , 12x, ' FFTPeriod  (seconds)') 

write  (3,90016)  NumCohAve 

90016  format  (lx , lPel2 . 5 , 12x, 'NumCohAve ' ) 

write  (3,90017)  NumRangeGates 

90017  format  (lx. i4 , 20x, 'NumRangeGates ' ) 

write  (3,90018)  NumRx 

90018  format  ( lx , i4 , 20x , 'NumRx' ) 

write  (3,90019)  PRP 

90019  format  (lx. lPel2 . 5 , 12x, 'PRP  (seconds)') 
write  (3,90020)  AltMin 

90020  format  (lx, lPel2 . 5 , 12x, 'AltMin  (meters)') 


write  (3,90021)  AltStep 

90021  format  (lx , lPel2 . 5 , 12x, 'AltStep  (meters)') 

write  (3,90022)  RxAttn 

90022  format  (lx, i4,20x, 'RxAttn' ) 

write  (3,90023)  RxPolarization 

90023  format  (lx, a2,22x, 'RxPolarization' ) 

write  (3,90024)  TxPower 

90024  format  (lx, lPel2 . 5 , 12x, 'TxPower  (Watts)') 

write  (3,90025)  (RxMask(i) , i-1, NumRx) 

90025  format  (10(lx, il) , 5x, 'RxMask' ) 


90026 


write  (3,90026)  TapeLabel 
format  (lx, a5 , 19x, 'TapeLabel' ) 


close 

return 

end 


(2) 
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GAFix . inc 


common  /GAFixl/  hdr  (  512 )  ,  clata(  3968 , 4 ) 
common  /GAFix2/  hold , invert , range , pathout 
integer*!  hdr , data .hold 
integer*2  invert , range , pulse , byte 
integer*4  PCount 
character*12  pathout 


rifeadfel  -  iii>_ 


Header . inc 

common  /H/  SoundingNumber , Year .Month , Day , Hour , Minute , Second , 

1  SiteName . DataXype . DataMode , FFTpts , Freql , Freq2 . 

2  PulseDuration. FFTPeriod.NuraCohAve , NumRangeGates , 

3  NumRx, PRP . AltMin. AltStep , RxAttn. RxPolar ization , 

4  TxPower ,RxMask(10) . datafile , TapeLabel 
integer*4  SoundingNumber , Year . Month , Day . Hour , Minute . Second 
character*14  SiteName 

character*4  DataXype , DataMode 
integer*4  FFTpts 

real*4  Freql , Freq2 , PulseDuration , FFXPer iod , NumCohAve 

integer*4  NumRangeGates .NumRx 

real*4  PRP, AltMin, AltStep 

integer*4  RxAttn 

character*2  RxPolarization 

real*4  XxPower 

integer*4  RxHask 

character*24  dataf ile ,hdrf ile , snake 
character*5  TapeLabel 


I- 


§ DEBUG 
c 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

C 

C 


program  FltrB 

FltrB  (  “  Filter  B)  is  a  replacement  for  Fltr  to  use  when  you 
can't  apply  the  pulse-256  correction,  i.e.,  when  you've  lost 
track,  due  to  missing  files  or  whatever,  of  the  pulse-256  offset. 
FltrB  is  a  4-pass  process  that  will  (1)  remove  the  local  DC 
offsets  for  each  file,  range,  receiver,  and  quadrature  channel, 

(2)  remove  single-pulse  noise  spikes,  (3)  calculate  the  receiver 
receiver  gains,  and  (4)  adjust  the  gains  and  phases  of  the  receivers 
A  list  of  input  files  are  expected  in  FltrB. txt. 

Link  FltrB+Header+FltrBl+FltrB2+FltrB3+FltrB4 


$ Include : ' Header . inc ' 

$Include ; ' FltrB . inc ' 

Dimension  FileA(60) , FileB(60) 
CHARACTER*24  FileA.FileB 


c 

c  get  the  names  of  the  input  and  output  files, 
c 

open  ( 1 , file-' FltrB . txt' .status-' old' ) 
ifile  -  1 

20001  read  (1 , end-20002 , fmt-90001)  FileA( ifile) 

90001  format  (a24) 
ifile  -  ifile  +  1 
go  to  20001 

20002  Numfiles  -  ifile  -  1 
datafile  -  fileA<l) 
call  Header 

write  (*,*)  'NumFiles  -  ' .NumFiles 
close  (1) 

do  10001  ifile  -  l.NumFiles 
Snake  -  FileA( ifile) 

write  (FileB(ifile) , 90002)  'c :\Buffer01\' , Snake(13 : 24) 

90002  format  (al2,al2) 

write  (*,*)  ifile,'  ' , FileA(ifile) , '  ', FileB( ifile) 

10001  continue 

************************************************************* 

c 

c  Filter  #1.  Remove  local  DC  offsets, 
c 

do  10011  ifile  -  l.NumFiles 
infile(ifile)  -  FileA(ifile) 
outfile(ifile)  -  FileB(ifile) 

10011  continue 

write  (*,*)  'FltrBl:' 

Call  FltrBl 

************************************************************* 

c 

c  Filter  #2.  Remove  noise  spikes, 
c 

do  10021  ifile  -  l.NumFiles 
infile(ifile)  -  FileB(ifile) 
outfile(ifile)  -  FileA(ifile) 
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10021  continue 


write  (*,*)  'fltrB2;' 

Call  FltrB2 

■^'k'k':k-icic-kicicifificieicic'kicicicicieie'kic-k-^'kicie‘kicic'k‘k:k-icicicicicii:if'k~k'k'k'k-k-k'krk'k-^'k'k'k-k'k'k'i'^ 

C 

c  Filter  #3.  Calculate  receiver  gains, 
c 

do  10031  ifile  =  l.NumFiles 
infile(ifile)  -  FileA(ifile) 
outfile(ifile)  -  FileB(ifile) 

10031  continue 

write  (*,*)  'FltrB3r' 

Call  FltrB3 

********************************************-***************** 

c 

c  Filter  #4.  Adjust  receiver  gains  and  phases, 
c 

do  10041  ifile  -  l.NumFiles 
inf ile( if ile)  -  FileB(ifile) 
outfile( ifile)  -  FileA(ifile) 

10041  continue 

write  (*,*)  'FltrB4;' 

Call  FltrB4 

************************************************************** 

90909  end 
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FitiEl . for 


$DEBUG 

c 

Subroutine  FltrBl 

C 

C  FltrBl(  —  Filter  #B1)  will  identify  and  remove  DC  offsets. 

c 

C  Link  FltrB+Header+FlcrBl+FltrB2+FltrB3+FltrB4 

C 

$  Include ; ' Header . inc ’ 

$  Inc lude : ’ FI trB . inc ' 

Dimension  power( 10 .512) , pdB( 10 , 512 ) , 

1  RunAve(40.10) .dcl(10.2) ,dc2(10,2) . 

2  NumAve ( 10) , erms( 10 , 2 ) , NumNoise (10) 

Real*4  xl , x2 , yl , y2 , del , dc2 , erms , errorx , errory , alpha , beta , sigma 
Integer*4  Finish, NumBig, pend, NumAve .NumNoise 
c 

c  Alpha  is  the  inverse  width  of  the  exponential  running  average 
c  Sigma*erms  is  the  quadrature  error  criterion  for  inclusion  in 
c  the  dc  average, 
c 

Alpha  -0.1 
Sigma  -  2 

do  10402  ifile  -  l.Numfiles 

if  ( ( ( if ile/25)*25  .eq.  ifile)  .or.  (ifile  .eq.  Numfiles))  then 

write  (*,90002)  ifile 

else 

write  (*,90001)  ifile 
endif 

90001  format  (lx,i2,\) 

90002  format  (lx,i2) 

open  (1 , file-infile( ifile) .status-' old' , form- 'binary' ) 
open  (2 , file-outfile(if ile) , status-' unknown' , form- 'binary ' ) 
c  write  (*,*)  'In  FltrBl:  if ile , outf ile  -  ' , if ile , outf ile ( if ile) 
do  10401  range  -  1 .NumRangeGates 
c 

c  3-pass  dc  average.  First  Pass:  get  raw  dc  average  (del), 
c 

do  10101  rx  -  l.NumRx 
NumAve (rx)  -  0 
NumNoise(rx)  -  0 
do  10101  quad  -  1,2 
del (rx, quad)  -  0 
dc2(rx,quad)  -  0 
DCave(rx,quad)  -  0 

10101  continue 

read  (1)  (( (data(rx, pulse , quad) , quad-1 , 2)  , 

1  pulse-1, FFTPts) , 

2  rx-l,NumRx) 
do  10102  rx  -  l,NumRx 

do  10102  pulse  -  1, FFTPts 
do  10102  quad  —  1,2 

dcl(rx,quad)  -  dcl(rx,quad)  +  float(data(rx, pulse .quad) ) 

10102  continue 

do  10103  rx  -  l.NumRx 

do  10103  quad  -  1,2 

dcl(rx,quad)  -  del (rx, quad) /FFTPts 

10103  continue 
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Second  pass:  get  rms  deviation  from  average 


do  10201  rx  “  l.NumRx 
do  10201  pulse  =  l.FFTPCs 
do  10201  quad  -  1.2 
enns(rx,quad)  -  erms(rx,quad) 

1  +  (dcl(rx , quad) - float(data( rx , pulse , quad) ) )**2 

10201  continue 

do  10202  rx  —  l.NumRx 
do  10202  quad  -  1.2 

erms ( rx . quad)  -  sqrt (erms (rx. quad)/FFTPts ) 
continue 


10202 

c 


Third  pass:  recalculate  the  dc  average;  exclude  points  chat 
lie  more  than  sigma  times  the  rms  deviation. 


do  10301  rx  —  l.NumRx 
do  10301  pulse  —  l.FFTPcs 

errorx  -  abs(dcl(rx, 1) -float(data(rx .pulse . 1) ) ) 
errory  -  abs(dcl(rx, 2) - float (data(rx . pulse . 2) ) ) 
if  (errorx  .It.  Sigma*erms(rx, 1)  .and. 

1  errory  .It.  Signia*erms(rx,  2) )  then 
dc2(rx.l)  -  dc2(rx,l)  +  float(data(rx. pulse . 1) ) 
dc2(rx.2)  -  dc2(rx,2)  +  float(data(rx.pulse . 2) ) 

NumAve(rx)  -  NumAve(rx)  +  1 
endif 

10301  continue 

do  10302  rx  -  l.NumRx 
do  10302  quad  -  1,2 
if  (NumAve(rx)  .gt.  0)  then 

dc2(rx,quad)  -  dc2(rx,quad)/float(NumAve(rx) ) 
else 

write  (*.*)  ' rx , quad , NumAve  -  ' ,rx.quad,NumAve(rx) 
endif 

10302  continue 

do  10303  rx  -  l.NumRx 
NumAve (rx)  -  0 
do  10303  pulse  -  l.FFTPts 
do  10303  quad  -  1,2 

data(rx. pulse, quad)  -  data(rx, pulse , quad)  -  nint(dc2(rx, quad) ) 

10303  continue 

write  (2)  (( (data(rx , pulse , quad) , quad-1 , 2) , 

1  pulse-1 , FFTPts) , 

2  rx-l.NumRx) 

10401  continue 
close  (1) 
close  (2) 

10402  continue 

return 

end 
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$DEBUG 

c 

Subroutine  FltrB2 
C 

C  FltrB2(  —  Filter  #B2)  will  identify  and  remove  noise  bursts, 
c  By  definition  here, 

c  an  increase  in  signal  power  in  one  receiver  is  a  noise  burst  if 

c  its  power  exceed  the  criterion  tor  a  single  pulse.  (Fix  this!!!; 

c  The  noise-burst  data  are  replaced  with  a  linear 
c  interpolation. 

c  Receivers  are  treated  individually  for  noise  elimination, 
c  FltrB2  uses  an  exponential  running  average  to  look  for  noise 
c  bursts.  To  get  starting  values  for  the  running 
c  average  of  each  sounding,  we  use  the  arithmetic  average, 
c  Beta  is  the  number  of  dB  above  the  running  average  for  the 
c  point  to  be  considered  too  big. 
c 

C  Link  FltrB+Header+FltrBl+FltrB2+FltrB3+FltrB4 
C 

$Include: 'Header. inc' 

$Include ; ' FltrB . inc ' 

Common  power(10, 512) ,pdB(10, 512) 

Dimension  RunAve(40, 10) ,NumAve(10) ,NumNoise(10) 

Real*4  xl ,x2 ,yl ,y2 ,dcl ,dc2 , erms , error , alpha .beta , sigma 
Integer*4  Finish, NumBig, pend, NumAve .NumNoise 
c 

c  Alpha  is  the  inverse  width  of  the  exponential  running  average, 
c  Beta  is  the  number  of  dB  above  the  running  average  for  a  point  to 
c  be  declared  a  noise  burst,  and  removed  from  the  data, 
c 

Alpha  -0.1 
Beta  -  10 

do  10409  ifile  -  l.Numfiles 

if  ( ( (if ile/25)*25  .eq.  ifile)  .or.  (ifile  .eq.  Numfiles))  then 

write  (*,90002)  ifile 

else 

write  (*,90001)  ifile 
endif 

90001  format  (lx,i2,\) 

90002  format  (lx,i2) 

open  (1 , file-inf ile (ifile) , status-' old' , form-' binary ' ) 
if  (ifile  .It.  Numfiles) 

1  open  (2 , file-inf ilein( ifile+1) , status-' old' , form-' binary ' ) 
open  (3 , f ile-outf ile(if ile) . status-' old' , form- 'binary' ) 
c  write  (*,*)  'FltrB2:  if ile , inf ile , outf ile  -  ', 
c  1  if ile , inf ile( if ile) , outf ile ( if ile) 

do  10408  range  -  1 ,NumRangeGates 
***************************************************>*********** 

c 

c  Fill  the  Arrays 

c 

c  Fill  the  Left-Hand  Side  of  the  Pulse  String  from  file  #1 
c  and  the  RHS  from  file  #2.  On  last  file,  skip  #2. 
c 

read  (1)  (( (daCa(rx , pulse , quad) , quad-1 , 2 ) , 

1  pulse-1, FFTPts) , 
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rx=l , NumRx ) 


2 

if  (ifile  .It.  Numfiles)  then 
read  (2)  (( (data(rx , pulse , quad) , quad=l , 2 )  , 

1  pulse-FFTPts+1 , 2*FFTPts) . 

2  rx=l, NumRx) 
pend  -  2*FFTPts 

else 

pend  -  FFTPts 
endif 

do  lOAOl  rx  —  1, NumRx 
do  10401  pulse  -  l.pend 

power(rx, pulse)  -  float(data(rx, pulse , 1) )**2 
1  +  float(data(rx, pulse , 2) ) **2 

if  (power(rx, pulse)  .ge.  1)  then 
pdB(rx , pulse)  -  10*logl0(power(rx, pulse) ) 
else 

pdB(rx , pulse)  -  1 
endif 

10401  continue 

if  (ifile  .eq.  1)  then 
do  10403  rx  -  1, NumRx 
RunAve ( range , rx)  -  0 
do  10402  pulse  —  l.pend 

RunAve ( range, rx)  -  RunAve ( range , rx)  +  pdB(rx , pulse) 

10402  continue 

RunAve (range.rx)  -  RunAve ( range , rx) /pend 

10403  continue 
endif 

************************************************************** 

c 

c  Check  the  data  point  by  point;  look  for  noise, 
c 

do  10407  rx  —  1, NumRx 
W  -  Beta  +  RunAve (range.rx) 
if  (ifile  .eq.  1)  then 

if  (pdB(rx,l)  .gt.  W  .and.  pdB(rx  2)  . le .  W)  then 
data(rx,l,l)  -  data(rx,2,l) 
data(rx,l,2)  -  data(rx,2,2) 

NumNoise(rx)  -  NuinNoise(rx)  +  1 
else 

RunAve ( r ange ,rx)  -  RunAve( range, rx)*( 1-alpha) 

1  +  pdB(rx, l)*alpha 

endif 
endif 

if  (ifile  .It.  NumFiles)  pend  -  FFTPts+1 
if  (ifile  .eq.  NumFiles)  pend  -  FFTPts-1 
do  10406  pulse  -  2, pend 
if  ( (pdB(rx, pulse-1)  . le .  W)  .and. 

1  (pdB(rx, pulse)  .gt.  W)  .and. 

2  (pdB(rx,pulse+l)  .le.  W))  then 
xl  -  float(data(rx,pulse- 1 , 1) ) 

x2  -  float(data(rx,pulse+l , 1) ) 
yl  -  float(data(rx,pulse- 1 , 2) ) 
y2  -  float(data(rx,pulse+l,2)) 
data(rx , pulse , 1)  -  nint( (xl+x2)/2 . ) 
data(rx,pulse,2)  -  nint( (yl+y2)/2 . ) 

NumNoise(rx)  -  NumNoise(rx)  +  1 
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else 

RunAve ( range , rx ) 

1 

endtf 

10406  continue 


=  RunAve(range , rx)*( 1-alpha) 
+  pdB(rx, pulse)*alpha 


if  (ifile  .eq.  NumFiles)  then 

if  (pdB(rx,FFTPts-l) .  It.  U  .and.  pdB(rx, FFTPts)  ■ ge .  W)  then 
data(rx,FFTPts,l)  -  data ( rx , FFTPts - 1 , 1) 
data(rx. FFTPts , 2)  -  data(rx, FFTPts- 1 . 2) 

NuinNoise(rx)  -  NuiiiNoise(rx)  +  1 
else 

RunAve (range , rx)  -  RunAve(range , rx)*( 1-alpha) 

1  +  pdB(rx,FFTPts)*alpha 

endif 
endif 


10407  continue 
write  (3) 

1 

2 

10408  continue 
close  (1) 
close  (2) 

10409  continue 


( ( (data(rx, pulse, quad) , quad-1 , 2) , 
pulse-1 , FFTPts) , 
rx-1  .NujiiRx) 


do  10412  rx  -  l.NumRx 
write  (*,*)  rx,NumNoise(rx) 
10412  continue 
close  (3) 
return 
end 


i 
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p  i  r  r  P,  3 


c 

$ DEBUG 
c 


Subroutine  FltrB3 

FltrB3(  -  Filter  #B3)  will  calculate  the  channel  voltage  gains. 
Link  FltrB+Header+FltrBl+FltrB2+FltrB3+FltrB4 


c 
c 
c 
c 
c 

$ Include : 'header. inc' 

$Include ; ' FltrB . inc ' 

Dimension  power(10,2) 

Integer*4  RefRx.RefQuad.RGL.RGU 

RefRx  =  5 

Ref Quad  -  1 

RGL  -  31 

RGU  -  40 

do  10003  Ifile  -  l.NumFiles 

if  ( ( ( if ile/25)*25  .eq.  ifile)  .or.  ifile  .eq.  Numfiles)  then 

write  (*,90002)  ifile 

else 

write  (*,90001)  ifile 
endif 

90001  format  (lx,i2,\) 

90002  format  (lx,i2) 

open  (1 , file-infile(ifile) , form-'binary ' ) 
open  (2 , file-outfile( ifile) , form-'binary' ) 
do  10002  range  -  1 ,NumRangeGates 
read  (1)  (( (data(rx, pulse .quad) , quad-1 , 2) , 

1  pulse-1, FFTPts) , 

2  rx-l.NumRx) 


do  10001  rx  —  l,NumRx 
do  10001  pulse  -  1, FFTPts 
do  10001  quad  -  1,2 

if  (range  .ge.  RGL  .and.  range  .le.  RGU) 

1  power (rx, quad)  -  power(rx, quad) 

2  +  float(data(rx, pulse , quad) )**2 
10001  continue 


write 


1 

2 


(2) 


( ( (da ta(rx, pulse , quad) , quad-1 , 2) , 
pulse-1 , FFTPts) , 
rx-1 , NumRx) 


10002  continue 
close  (1) 
close  (2) 

10003  continue 

do  10011  rx  -  1, NumRx 
do  10011  quad  -  1,2 

Vgain(rx,quad)  -  sqrt(power(rx, quad) /power (RefRx , RefQuad) ) 
10011  continue 

write  (*,*)  'Voltage  Gains:' 

write  (*,*)  '  rx  quad  Vgain' 

do  10021  rx  -  1, NumRx 

do  10021  quad  -  1,2 

write  (*,*)  rx.quad, Vgain(rx, quad) 

10021  continue 
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99999  end 
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F 1 1  r  B  4  .  f  C'  r 

c 

$ DEBUG 
c 

Subroutine  FltrB4 
c 

c  FltrB4(  -  Filter  #B4)  will  adjust  the  receiver  voltage  gains  and 
c  phase  offsets 
c 

c  Link  FltrB+Header+FltrBl+FltrB2+FltrB3+FltrB4 
c 

$ Include: 'header. inc' 

$Include : ' FltrB . inc' 

Dimension  Correct(lO) 
complex*8  V.srmo 
Real*4  x.y.vtemp 
srmo  -  cmplx(0,l) 
pi  -  3.1415927 
contor  -  pi/180 

Correct(l)  -  0 
Correct(2)  -  0 
Correct(3)  -  0 
Correct(4)  -  0 
Correct(5)  -  0 
Correct(6)  -  0 
Correct (7)  -  0 
Correct(8)  -  0 
Correct(9)  -  0 
Correct(lO)  -  0 
c 

c  experimental  set  to  adjust  to  airplane, 
c 

Correct(l)  -  contor  *  (-17.86) 

Correct(2)  -  contor  *  (66.23  -  90  -  25) 

Correct(3)  -  contor  *  (41.16) 

Correct(4)  -  contor  *  (86.92  -  90  -  25) 

Correct(5)  -  contor  *  (0.00) 

Correct(6)  -  contor  *  (74.71  -  90  -  25) 

Correct(7)  -  contor  *  (-26.81  -  15) 

Correct(8)  -  contor  *  (71.20  -  90  -  25  -10) 

Correct(9)  -  contor  *  (-14.01) 

Correct(lO)  -contor  *  (75.71  -  90  -  25  +  10) 

c 

c  The  following  corrections  from  an  average  over  5  tapes 
c  (Gr'237,238,239,242,254). 
c  These  judged  best:  11/30/89. 
c 

Correct(l)  -  contor  *  (-17.86) 

Correct(2)  -  contor  *  (66.23  -  90) 

Correct(3)  -  contor  *  (41.16) 

Correct(^')  -  contor  *  (86.92  -  90) 

Correct(5)  -  contor  *  (0.00) 

Correct(6)  -  contor  *  (74.71  -  90) 

Correct(7)  -  contor  *  (-26.81) 

Correct(8)  -  contor  *  (71.20  -  90) 

Correct(9)  -  contor  *  (-14.01) 

Correct(lO)  -contor  *  (75.71  -  90) 

do  10006  ifile  -  l.NumFiles 
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if  (((ifile/25)*25  .eq.  ifile)  .or.  ifiie  .eq.  Nuir. files)  then 

write  (*,90002)  ifile 

else 

write  (*,90001)  ifile 
endif 

90001  format  (lx,i2,\)  # 

90002  format  (lx, 12) 

open  (1 , f ile— inf ile ( if ile) , form- 'binary' ) 
open  (2 , file-outfile(ifile) , form-' binary ' ) 
do  10005  range  —  1 , NumRangeGates 

read  (1)  (( (data(rx, pulse , quad) , quad-1 , 2) ,  0 

1  pulse-1 , FFTPts ) , 

2  rx-l,NumRx) 


do  10002  rx  -  l.NumRx 
do  10002  pulse  -  1, FFTPts 

c  • 

c  Correct  voltage  gains, 
c 

do  10001  quad  —  1,2 

vtemp  -  float(data(rx, pulse , quad) ) 

data (rx, pulse, quad)  -  nint(vtemp/Vgain(rx , quad) ) 

10001  continue  ^ 

c 

c  Correct  phases, 
c 

X  -  float(data(rx, pulse, 1) ) 
y  -  f loat( data (rx, pulse, 2)) 

V  -  cmplx(x,y)*cexp(+srmo*correct(rx) )  • 

data(rx, pulse , 1)  -  nint(real(V) ) 
data(rx,pulse,2)  -  nint(aimag(V) ) 

10002  continue 


write  (2) 

1 

2 

10005  continue 
close  (1) 
close  (2) 

10006  continue 
99999  end 


( ( (data( rx , pulse , quad) , quad-1 , 2 ) 
pulse-1 , FFTPts) 
rx-1 ,NumRx) 
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P.  T  P  PM 


$Debug 

c 

Program  BSPPM 

c 

'k'k'k-k'k'kicrkicicicicicicicicicicicic-iei:ic-kieicic'k-i:ik'k-k-Jcic'kic'kicici^-k-k'ki::k'k'kii:'kic'kikisii:ic'ki^'Jc'kic-k'ki>ic'k 

* 

*  Scattering-Point  Parameter  Analysis  Program  * 

*  Copyright  1989,  Holodyne  Limited  1986.  * 

*  All  Rights  Reserved.  * 

*  December  8,  1989  * 

*  ****-*****************'******St***********Tt**Tt^****TtTAr***'**Tt****-)t*-*****'jt* 
C 

c  Format  for  Scattering-Point  Parameters; 
c  1.  Altitude  (km), 

c  2.  Radial  velocity  (m/sec). 

c  3.  Zenith  angle  in  East-West  meridian  (degrees), 

c  4.  Zenith  angle  in  North-South  meridian  (degrees), 

c  5.  Voltage  amplitude  on  Dipole  #1  (East-pointing); 
c  sura  of  5  steeled  voltages. 

c  6.  Phase  on  Dipole  #1  at  vertex  of  array  (degrees), 
c  7.  Voltage  amplitude  on  Dipole  #2  (North-pointing); 
c  sum  of  5  steered  voltages. 

c  8.  Phase  on  Dipole  #1  at  vertex  of  array  (degrees), 
c  9.  Width  of  E-W  zenith-angle  window, 

c  10.  Width  of  N-S  zenith-angle  window, 

c 

c  bsppM.for  calls  bfftM, fft2cm, header ,btestM,bsteerM,  and  bsortM. 
c 

c  March  10,  1991 

c  Scattering-point  parameters  9  &  10  added:  3/18/91. 
c 

$ Include : ' Bsppm. inc ' 

$ Inc lude ; ' header . inc ' 

real*4  ZAWdegrees 

integer*4  SPPbyRange .NoiseCount .NoiseLimit 

srmo  -  cmplx(0,l) 

pi  -  3.14159265 

Clight  -  3e8 

contod  -  180/pi 

contor  -  1/contod 

AntLocation(l)  -  -1.0 

AntLocation(2)  —  -0.5 

AntLocation(3)  —  0.0 

ZAWdegrees  -  20 

ZAWindow  -  ZAWdegrees*contor 

Threshold  -  le-2 

LPswitch  -  0 

TxPolarization  -  'L' 

NoiseLimit  -  255*5 

open  (3 , file-' Bsppm. mbs' , form-'binary' ) 
open  (1 , file-' Bsppm. txt' ) 

20001  read  (1 , fmt-90001 ,end-90909)  datafile 
write  (*,*)  '  ' 
write  (*,90002)  datafile 

90001  format  (a24) 

90002  format  ('  Processing' , lx, a24) 

c  write  (*,90003)  ZAWdegrees , Threshold, NoiseLimit 

90003  format  (lx, 'ZAWindow  -  ',f4.1,'  Threshold  -  ',lPe6.0, 
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1 


NoiseLimi c 


Call  Header 
DataMode  -  '0003' 

open  (2 , file-datafile , status-' old'  , form-' binary '  ) 

SPPnumber  -  0 

SumPower  -  0 

ibelly  -  0 

NoiseCount  —  0 

do  10001  ireject  -  1,12 
reject(ireject)  -  0 
10001  continue 


write  (*,*)  'Number  of  Scattering  Points:' 
Do  10004  j Range  -  1 .NumRangeGates 
SPPbyRange  -  0 


read  (2) 

1 

2 

3 

read  (2) 

1 

2 

read  (2) 

1 

2 


( ( ( (Data(l , ant , dipole .pulse , quad) .  quad-1 ,2) , 

pulse-1 ,256) , 
dipole-1 , 2 ) , 
ant-1 , 3) 

(  ( (Data(2 , 2 .dipole .pulse , quad) ,  quad-1 , 2) , 

pulse-1 ,256) , 
dipole-1 , 2 ) 

( ( (Data(2 , 1 , dipole .pulse , quad) ,  quad-1 , 2) , 

pulse-1 ,256) , 
dipole-1 ,2) 


do  10002  quad  -  1,2 
do  10002  pulse  -  1,256 

c  (Channels  3  and  4  are  reversed  on  tapes  44-88.) 
c  iswap  -  data( 1,2,1, pulse, quad) 
c  data( 1,2,1, pulse, quad)  -  data(l , 2 , 2 .pulse , quad) 
c  data(l , 2 , 2 .pulse .quad)  -  iswap 
do  10002  dipole  -  1,2 

Data(2 , 3 , dipole .pulse .quad)  —  Data(l , 3 , dipole , pulse , quad) 
10002  continue 


Call  BFFTM 


do  10003  dopp  -  1,256 
if  (dopp  .eq.  128)  go  to  10003 
fallflag  -  0 
Call  BTESTM 

if  (fallflag  .eq.  1)  go  to  10003 
Range  -  (AltMin  +  ( jRange- l)*AltStep)*le-3 
if  (Range  .le.  0)  go  to  10003 
c 

c  Real  scattering  point, 
c 

Altitude  -  Range*SqRt(l-Sin(ThetaEW)**2 
1  -Sin(ThetaNS)**2) 

FDopp  -  (dopp-128.)/(FFTPeriod) 

VDopp  -  FDopp*CLight/(2*Freql) 

Call  BSTEERM 

c  Filters,  if  any,  go  here  (if  fail  go  to  10003): 
c 

c  End  filter.  Fill  the  next  SPPtemp  slot  with  the  10  SPPs. 
SPPnumber  -  SPPnumber  +  1 
SPPbyRange  -  SPPbyRange  +  1 


SPPcemp(SPPnumber , 1)  *  Altitude 

SPPtemp(SPPnumber , 2)  -  VDopp 

if  (DataHode  .eq.  '0002')  then 

SPPtenip(SPPnumber ,  3)  —  ThetaEW*contod 

SPPtemp(SPPnumber ,4)  -  ThetaNS*contod 

elseif  (DataMode  .eq.  '0003')  then 

rotate  -  pi/4 

sinEW  -  sin(ThetaEW) 

sinNS  -  sin(ThetaNS) 

sinZA  —  sqrt(sinEW**2  +  sinNS**2) 

if  ((abs(sinEW)  .gt.  le-5)  .or.  (abs(sinNS)  .gt.  le-5))  then 

phinew  -  atan2(sinNS , sinEW)  +  rotate 

else 

phinew  -  0 
endif 

SPPtemp(SPPnuinber ,  3)  - 
1  contod*asin(sinZA*cos(phinew) ) 

SPPtemp(SPPnumber ,4)  - 
1  contod*asin(sinZA*sin(phinew) ) 
endif 

spptemp(SPPnumber , 5)  -  VAinplitude(l) 
spptemp(SPPnumber , 6)  -  Faze(l)*contod 
spptemp(SPPnumber ,  7)  -  VAinplitude(2) 
sppCemp(SPPnuniber,8)  -  Faze(2)*contod 
sppteiBp(SPPnumber,9)  -  ZASpread( l)*contod/3 
sppcemp(SPPnumber ,10)  -  2LASpread(2)*contod/3 
c  spptemp  overflow  protection: 

if  (SPPnumber  .eq.  2500)  then 

write  <*,*)  'Hit  2500  scattering  points.  Full  belly.' 
ibelly  -  1 
go  to  20002 
endif 

10003  continue 

20002  if  ( (jRange/10)*10  .ne.  jRange)  then 
write  (*,90004)  sppByRange 

else 

write  (*,90005)  SppByRange 
endif 

if  (JRange  .ge.  11  .and.  jRange  . le .  15) 

1  NoiseCount  -  NoiseCount  +  SppByRange 

90004  format  (lx,i5,\) 

90005  format  (lx, 15) 

if  (ibelly  .eq.  1)  go  to  20003 

10004  continue 

20003  close  (2) 

write  (*,*)  'Total  #  of  scattering  points  found:  ',sppnumber 

if  ((NoiseCount  .It.  NoiseLimit)  .and.  (sppnumber  .gt.  0))  then 

S(l)  -  -999 

S(2)  -  Year 

S(3)  -  Month 

S(4)  -  Day 

S(5)  -  Hour 

S(6)  -  Minute 

S(7)  -  Second 

S(8)  -  sppnumber 

s(9)  -  -999 


s(10)  -  -999 

write  (3)  (S(is) , is-1 , 10) 


Call  BSORTM 
else 

write  (*,*)  'Rejected.  NoiseCount  =  ' .NoiseCount 
endif 

c  write  (*,*)  'Rejection  Statistics;' 

c  write  (*,*) 

cl'  1234  56789 

c  write  (*,90006)  ( rej ect( irej ect) , ire j ect-1 , 11) 

90006  format  (lx,ll(i6)) 
go  to  20001 
90909  close  (1) 
close  (2) 
close  (3) 

c  call  BellSub 

end 


10  li¬ 


es 


c 


BFFTM 


$Debug 

c 

Subroutine  BFFTM 
c 

$ include : ' BsppM. inc ' 

§ inc lude ; ' Header . inc ' 

dimension  a(256) , iwk(9) 
complex*16  a 
real*4  xend.yend 
integer*2  dp,dp2 
integer*^  iwk 
do  10004  dir-1,2 
do  10004  dipole  -  1,2 
Voltage(dir , dipole)  -  0 
do  10004  ant-1 , 3 
c 

c  replace  the  endpoints  by  the  average  endpoint, 
c 

xend  -  float (data (dir , ant , dipole , 1 , l)+data(dir , ant .dipole ,256,1)) 
yend  -  f loat( data (dir , ant .dipole , 1 , 2)+data(dir . ant .dipole ,256,2)) 
data(dir , ant , dipole , 1 , 1)  -  nint(xend/2 . 0) 
data(dir , ant .dipole , 256 , 1)  -  nint (xend/2 . 0) 
data(dir , ant , dipole , 1, 2)  -  nint(yend/2 . 0) 
data(dir , ant , dipole , 256 , 2)  -  nint(yend/2 . 0) 
c 

c  transfer  the  data  into  "a"  and  perform  the  fft. 
c 

do  10001  dp-1.256 

a (dp)  -  cmplx(data(dir , ant , dipole , dp , 1) ,data(dir , ant , dipole , dp , 2) ) 
10001  continue 


call  fft2cm(a, 8 , iwk) 
c 

c  find  the  total  power, 
c 

psum  -  0 

do  10002  dp  -  1,256 

x  -  float(Data(dir , ant .dipole , dp , 1) ) 
y  -  float(Data(dir.ant.dipole.dp.2) ) 
psum  -  psum  +  x**2  +  3r**2 

10002  continue 

do  10003  dp  -  1,256 

p  -  cabs(a(dp) )**2 

if  (p  .ge.  psum*THRESHOLD)  then 

xdata (dir. ant. dipole. dp. 1)  -  real(a(dp)) 

xdata(dir.ant.dipole.dp.2)  -  aimag(a(dp)) 

else 

xdata(dir , ant. dipole .dp, 1)  -  0 
xdata(dir , ant , dipole , dp , 2)  -  0 
endif 

10003  continue 

10004  continue 
return 
end 
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C  COMPUTER 
C 

C  PURPOSE 
C 

c 

c 

C  USAGE 
C 

ARGUMENTS  A 


M 


IWK 


COMPUTE  THE  FAST  FOURIER  TRANSFORM  OF  A 

COMPLEX  valued  SEQUENCE  OF  LENGTH  EQUAL  TO 
A  POWER  TWO 

CALL  FFT2CM  (A.M.IWK) 

COMPLEX  VECTOR  OF  LENGTH  N,  WHERE 

ON  INPUT  A  CONTAINS  THE  COMPLEX  VALUED 
SEQUENCE  TO  BE  TRANSFORMED. 

ON  OUTPUT  A  IS  REPLACED  BY  THE 
FOURIER  TRANSFORM. 

INPUT  EXPONENT  TO  WHICH  2  IS  RAISED  TO 
PRODUCE  THE  NUMBER  OF  DATA  POINTS,  N 
(I.E.  N  -  2**M) . 

WORK  VECTOR  OF  LENGTH  M+1. 


REMARKS  1.  FFT2CM  COMPUTES  THE  FOURIER  TRANSFORM,  X,  ACCORDING 
TO  THE  FOLLOWING  FORMULA; 

X(K+1)  -  SUM  FROM  J  -  0  TO  N-1  OF 

A(J+1)*CEXP((0.0, (2.0*PI*J*K)/N)) 

FOR  K-0,1 . N-1  AND  PI-3.1415. . . 

NOTE  THAT  X  OVERWRITES  A  ON  OUTPUT. 

2.  FFT2CM  CAN  BE  USED  TO  COMPUTE 


X(K+1)  -  (1/N)*SUM  FROM  J  -  0  TO  N-1  OF 

A(J+1)*CEXP((0.0, (-2.0*PI*J*K)/N)) 
FOR  K-0,1, . . . ,N-1  AND  PI-3.1415. . . 

BY  PERFORMING  THE  FOLLOWING  STEPS; 


C 

C 

C 

C 


C 


DO  10  I-1,N 

A(I)  -  CONJG(A(I)) 

10  CONTINUE 

CALL  FFT2CM  (A,M,IWK) 

DO  20  1-1, N 

A(I)  -  CONJG(A(I))/N 
20  CONTINUE 


SUBROUTINE  FFT2CM  (A,M,IWK) 

SPECIFICATIONS  FOR  ARGUMENTS 

INTEGER*4  M 

INTEGER*4  IWK(l) 

COMPLEX*! 6  A(l) 

SPECIFICATIONS  FOR  LOCAL  VARIABLES 


INTEGER*4 

1 

DOUBLE  PRECISION 

1 

2 

COMPLEX*16 


I,ISP,J,JJ,JSP,K,K0,K1,K2,K3,KB,KN,MK,MM,MP,N, 

N4,N8,N2,LM,NN,JK 

RAD, Cl , C2 , C3 , SI , S2 , S3 , CK , SK , SQ , AO , A1 , A2 , A3 , 

BO , B1 , B2 , B3 , TWOPI , TEMP , 

ZERO,ONE,ZO(2),Z1(2) ,Z2(2) ,Z3(2) 

ZAO , ZAl , ZA2 , ZA3 , AK2 , sor t ( 16 384 ) 


c 

c 

c 


c 


I 


c 


I 


I 


EQUIVALENCE 

1 

2 

3 

DATA 

1 

2 

3 

DATA 


MP  -  M+1 
N  -  2**M 
IWK(l)  =  1 
MM  -  (M/2)*2 
KN  -  N+1 


(ZAO.ZO(l))  ,  (ZAl.ZKD)  ,  (ZA2,Z2(1)  /  , 
(ZA3.Z3(1))  ,  (AO,ZO(I))  ,  (BO.ZOC  ))  ,  (Al.ZUlj;  , 
(B1,Z1(2))  ,  (A2,Z2(1)  )  ,  (B2  ,Z2(2)  'I  ,  (A3  .  Z3(l)  )  , 
(B3.Z3(2)) 

SQ/.7071067811865475D0/, 

SK/. 3826834323650898D0/, 
CK/.9238795325112868DO/. 
TWOPI/6.283185307179586DO/ 

ZERO/0 . ODO/ , ONE/1 . ODO/ 

SQ-SQRT2/2 ,SK=SIN(PI/8) , CK=COS ( PI/8 ) 
TVOPI-2*PI 

FIRST  EXECUTABLE  STATEMENT 


INITIALIZE  WORK  VECTOR 

DO  5  1-2, MP 

IWK(I)  -  IWK(I-1)+IWK(I-1) 

5  CONTINUE 

RAD  -  TWOPI/N 
MK  -  M  -  4 
KB  -  1 

IF  (MM  .EQ.  M)  GO  TO  15 
K2  -  KN 

KO  -  IWK(MM+1)  +  KB 
10  K2  -  K2  -  1 

KO  -  KO  -  1 

AK2  -  A(K2) 

A(K2)  -  A(K0)  -  AK2 
A(K0)  -  A(K0)  +  AK2 
IF  (KO  .GT.  KB)  GO  TO  10 
15  Cl  -  ONE 

SI  -  ZERO 

JJ  -  0 


K  -  MM  -  1 


J  -  4 

IF  (K  .GE.  1)  GO  TO  30 
GO  TO  70 

20  IF  (IWK(J)  .GT.  JJ)  GO  TO  25 
JJ  -  JJ  -  IWK(J) 

J  -  J-1 

IF  (IWK(J)  .GT.  JJ)  GO  TO  25 
JJ  -  JJ  -  IWK(J) 

J  -  J  -  1 
K  -  K  +  2 
GO  TO  20 

25  JJ  -  IWK(J)  +  JJ 
J  -  4 

30  ISP  -  IWK(K) 

IF  (JJ  .EQ.  0)  GO  TO  40 

RESET  TRIGONOMETRIC  PARAMETERS 


C2  -  JJ  *  ISP  *  RAD 
Cl  -  DC0S(C2) 

51  -  DSIN(C2) 

35  C2  -  Cl  *  Cl  -  SI  *  SI 

52  -  Cl  *  (SI  +  SI) 

C3  -  C2  *  Cl  -  S2  *  SI 

53  -  C2  *  SI  +  S2  *  Cl 
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n  o 


c 

c 


40  JSP  -  ISP  +  KB 


DETERMINE  FOURIER  COEFFICIENTS 
IN  GROUPS  OF  4 


DO 


45 


50 


55 


60 


50  I-1,ISP 
KO  -  JSP  -  I 
K1  -  KO  +  ISP 
K2  -  K1  +  ISP 
K3  -  K2  +  ISP 
ZAO  -  A(KO) 
ZAl  -  A(K1) 
ZA2  -  A(K2) 
ZA3  -  A(K3) 

IF  (SI  .EQ. 


ZERO)  GO  TO  45 


TEMP 

=  A1 

A1  = 

Al  * 

Cl  - 

B1 

* 

SI 

B1  - 

TEMP 

*  SI 

+ 

*  Cl 

TEMP 

-  A2 

A2  - 

A2  * 

C2  - 

B2 

* 

S2 

B2  - 

TEMP 

*  S2 

+ 

B2 

*  C2 

TEMP 

-  A3 

A3  - 

A3  * 

C3  - 

B3 

* 

S3 

B3  - 

TEMP 

*  S3 

+ 

B3 

*  C3 

TEMP 

-  AO 

+  A2 

A2  - 

AO  - 

A2 

AO  - 

TEMP 

TEMP 

-  Al 

1-  A3 

A3  - 

Al  - 

A3 

A1  - 

TEMP 

TEMP 

-  BO 

+  B2 

B2  - 

BO  - 

B2 

BO  - 

TEMP 

TEMP 

-  B1 

+  B3 

B3  - 

B1  - 

B3 

B1 
A(KO)  - 
A(K1)  - 
A(K2)  - 
A(K3)  - 
CONTINUE 
IF  (K  .LE. 
K  -  K  -  2 
GO  TO  30 
KB  -  K3  + 


TEMP 

DCMPLX(A0+A1 , BO+Bl) 
DCMPLX(AO-Al.BO-Bl) 
DCMPLX(A2-B3 , B2+A3) 
DCMPLX(A2+B3 . B2 - A3 ) 


1)  GO  TO  55 


ISP 


CHECK  FOR  COMPLETION  OF  FINAL 
ITERATION 


IF  (KN  .LE.  KB)  GO  TO  70 
IF  (J  .NE.  1)  GO  TO  60 
K  -  3 
J  -  MK 
GO  TO  20 
J  -  J  -  1 


65 


70 


C2 

- 

Cl 

IF 

(J 

.NE. 

2)  ' 

GO 

TO 

65 

Cl 

- 

Cl  * 

CK  + 

SI 

* 

SK 

SI 

- 

SI  * 

CK  - 

C2 

* 

SK 

GO 

TO 

I  35 

Cl 

(Cl  ■ 

■  SI) 

* 

SQ 

SI  -  (C2 
GO  TO  35 
CONTINUE 


+  SI)  *  SQ 
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c 

c 

c 


c 


PERMUTE  THE  COMPLEX  VECTOR  IN 
REVERSE  BINARY  ORDER  TO  NORMAL 
ORDER 

IF(M  .LE.  1)  GO  TO  9005 
MP  -  M+1 
JJ  -  1 

INITIALIZE  WORK  VECTOR 

IWK(I)  -  I 
DO  75  I  -  2,MP 

IWK(I)  -  IWK(I-l)  *  2 
75  CONTINUE 

N4  -  IWK(MP-2) 

IF  (M  .GT.  2)  N8  -  IWK(MP-3) 

N2  -  IWK(MP-l) 

LM  -  N2 

NN  -  IWK(MP)+1 
MP  -  MP-4 


C  DETERMINE  INDICES  AND  SWITCH  A 

J  =  2 

80  JK  -  JJ  +  N2 
AK2  -  A(J) 

A(J)  -  A(JK) 

A(JK)  -  AK2 
J  -  J+1 

IF  (JT  .GT.  N4)  GO  TO  85 
JJ  -  JJ  +  N4 
GO  TO  105 
85  JJ  -  JJ  -  N4 

IF  (JJ  .GT.  N8)  GO  TO  90 
JJ  -  JJ  +  N8 
GO  TO  105 
90  JJ  -  JJ  -  N8 
K  -  MP 

95  IF  (IWK(K)  .GE.  JJ)  GO  TO  100 
JJ  -  JJ  -  IWK(K) 

K  -  K  -  1 
GO  TO  95 

100  JJ  -  IWK(K)  +  JJ 
105  IF  (JJ  .LE.  J)  GO  TO  110 
K  -  NN  -  J 
JK  -  NN  -  JJ 
AK2  -  A(J) 

A(J)  -  A(JJ) 

A(JJ)  -  AK2 
AK2  -  A(K) 

A(K)  -  A(JK) 

A(JK)  -  AK2 
110  J  -  J  +  1 

C  CYCLE  REPEATED  UNTIL  LIMITING  NUMBER 

C  OF  CHANGES  IS  ACHIEVED 

IF  (J  .LE.  LM)  GO  TO  80 
C 

9005  CONTINUE 


c 

c  re-order  the  spectrum  so  that  it  runs  from  most-negative 
c  to  most-positive,  with  dc  in  the  middle,  and  positive 
c  defined  as  increasing  phase  with  time. 


c 


iflip  -  0 


10001 


10002 


10003 


ipa  -  N/2 
ipb  -  1 

do  10001  ip  -  ipa, ipb, -1 
iflip  -  iflip  +  i 
sort(iflip)  -  A(ip) 
continue 

iflip  -  N/2 
ipa  -  N 
ipb  -  N/2+1 

do  10002  ip  -  ipa, ipb, -1 
iflip  -  iflip+1 
sort(iflip)  -  A(ip) 
continue 

ipb  -  N 

do  10003  ip  -  l,ipb 

A(ip)  -  sort(ip) 

continue 

RETURN 

END 


94 


Ho  A  Ho  3”  Z  I  Z 

c 

c 

Subroutine  Header 
c 

c  This  subroutine  reads  "Header.dat",  an  ascii  file 
c  containing  the  radar  parameters.  The  time  of  the 
c  sounding  is  obtained  from  the  name  of  the  data  file 
c  "datafile".  Since  time  is  the  only  parameter  that 
c  changes  from  sounding  to  sounding,  this  eliminates 
c  handling  a  separate  header  file  for  each  data  file, 
c 

c  March  10,  1991 
c 

$Include : ' Header . inc ' 

character*!  thingi , thing2 
c  write  (*,*)  datafile 
iunit  -  88 

20001  open  (iunit, file— 'Header .dat' , iostat-iocheck, status=’ old' ) 
if  (iocheck  .gt.  0)  then 
iunit  -  iunit+1 
go  to  20001 
endif 

read  (iunit,*)  SoundingNumber 
read  (iunit,*)  Year 
read  (iunit,*)  Month 
read  (iunit,*)  Day 
read  (iunit,*)  Hour 
read  (iunit,*)  Minute 
read  (iunit,*)  Second 
read  (iunit, ' (A) ' )  SiteName 
read  (iunit, ' (A) ' )  DataType 
read  (iunit, ' (A) ' )  DataMode 
read  (iunit,*)  FFTpts 
read  (iunit,*)  Freql 
read  (iunit,*)  Freq2 
read  (iunit,*)  PulseDuration 
read  (iunit,*)  FFTPeriod 
read  (iunit,*)  NumCohAve 
read  (iunit,*)  NumRangeGates 
read  (iunit,*)  NumRx 
read  (iunit,*)  PRP 
read  (iunit,*)  AltMin 
read  (iunit,*)  AltStep 
read  (iunit,*)  RxAttn 
read  (iunit, ' (A) ' )  RxPolarization 
read  (iunit,*)  TxPower 
read  (iunit,*)  (RxMask(i) , i-1, NumRx) 
read  (iunit, ' (A) ' )  TapeLabel 
close  (iunit) 
c 

c  Get  the  real  time  from  the  name  of  the  data  file, 
c 

do  10001  ip lace  -  1,24 

if  (datafile(iplace ; iplace)  .eq.  '.')  then 
imark  —  iplace 
go  to  20002 
10001  endif 

write  (*,*)  'No  .  found  in  datafile  name.' 
return 
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20002  do  10002  iplace  -  imark- 8  .  i.uark-2 , 2 
thingl  -  datafiLe( Lplace ; iplace) 
thing2  -  dataf ile( iplace+1 ; iplace+1 ) 
if  (thingl  .eq.  '0')  then 
il  -  0 


elseif 
il  -  1 

(thingl 

.eq. 

'1') 

then 

elseif 
il  -  2 

( thingl 

■  eq. 

'2'  ) 

then 

elseif 
il  -  3 

(thingl 

•  eq. 

'3') 

then 

elseif 
il  -  4 

( thingl 

■  eq. 

*4* ) 

then 

elseif 
il  -  5 

(thingl 

.eq. 

•5‘) 

then 

elseif 
il  -  6 

(thingl 

•  eq. 

'6') 

then 

elseif 
il  -  7 

( thingl 

.eq. 

•V) 

then 

elseif 
il  “■  8 

( thingl 

.eq. 

'8' ) 

then 

elseif 

(thingl 

.eq. 

'9' ) 

then 

il  -  9 
else 


11  -  0 
endlf 

if  (thing2  .eq.  '0')  then 

12  -  0 


elseif  (thing2 
i2  -  1 

•eq.  '1') 

then 

elseif  (thing2 
i2  -  2 

•eq.  '2') 

then 

elseif  (thing2 
i2  -  3 

.eq.  '3') 

then 

elseif  (thing2 
i2  -  4 

. eq .  ' 4' ) 

then 

elseif  (thing2 
i2  -  5 

•eq.  '5') 

then 

elseif  (thing2 
i2  -  6 

.eq.  '6') 

then 

elseif  (thing2 
11  -  1 

.eq.  '7') 

then 

elseif  (thing2 
12-8 

eq.  '8') 

then 

elseif  (thing2 

i2  -  9 

else 

12-0 

endif 

. eq .  ' 9 ' ) 

then 

if  (iplace  .eq. 

imark-8) 

Month 

-  10*il 

if  (iplace  .eq. 

imark-6) 

Day  — 

10*il  + 

if  (iplace  .eq. 

imark-4) 

Hour  - 

10*il 

if  (iplace  .eq. 

imark-2) 

Minute 

-  10*i 

10002  continue 

thingl  -  datafile ( imark+1 : imark+l) 
thing2  -  datafile ( imark+2 : imark+2) 
if  (thingl  .eq.  '0')  then 


+  i2 
i2 
i2 

+  i2 


il  -  0 

elseif  (Chlngl  .eq. 
il  -  1 

elseif  (thingl  .eq. 
il  -  2 

elseif  (thingl  .eq. 
il  -  3 

elseif  (thingl  .eq. 
il  -  4 

elseif  (thingl  .eq. 
il  -  5 

elseif  (thingl  .eq. 
il  -  6 

elseif  (thingl  .eq. 
il  -  7 

elseif  (thingl  .eq. 
il  -  8 

elseif  (thingl  .eq. 
il  -  9 

else 

11  -  0 
endif 

if  (thing2  .eq.  '0') 

12  -  0 

elseif  (thing2  .eq. 
i2  -  1 

elseif  (thing2  .eq. 
12-2 

elseif  (thlng2  .eq. 
12-3 

elseif  (thlng2  .eq. 
12  —  4 

elseif  (thlng2  .eq. 
12-5 

elseif  (thlng2  .eq. 
12-6 

elseif  (thlng2  .eq. 
12-7 

elseif  (thlng2  .eq. 
12-8 

elseif  (thlng2  .eq. 
12-9 
else 
12-0 
endif 

Second  -  10*11  +  12 


return 

end 


'  1 ' )  then 
'2')  then 
'  3 ' )  then 
'4' )  then 
'  5 ' )  then 
'6')  then 
'7')  then 
'8')  then 
'9')  then 

then 

' 1 ' )  then 
' 2 ' )  then 
'3')  then 
'4')  then 
'5')  then 
' 6 ' )  then 
’ 7 ' )  then 
' 8 ' )  then 
' 9 ' )  then 
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Subroutine  BTESTM 


c  This  subroutine  applies  the  interferometry  algorithms. 

c 

c  May  7.  1990 
c 

$  include : ' BsppM . inc ' 

$  include : ' Header . inc' 

complex  XX, SumVolt ,VA,VB , ordinary 

do  10099  dir  -  1,2 
ZASpread(dir)  -  0 
do  10098  dipole  -  1,2 
ZAW  -  3*ZAWindow  -  ZASpread(dir ) 
do  lOOOA  ant  -  1,3 
c 

c  Test  #1:  Reject  this  Doppler  frequency  if  both  quadrature 
c  components  are  too  small  on  any  antenna  for  an  accurate  calculati 
c  of  the  phase.  This  happens  not  too  often, 
c 

if  (abs(xData(dir, ant, dipole, dopp, 1) )  .le.  10  .and. 

1  abs(xData(dir ,ant, dipole, dopp, 2) )  .le.  10)  then 
reject(l)  -  reject(l)  +  1 
failflag  -  1 
go  to  90909 
endif 
c 

c  calculate  the  phase, 
c 

Phase(dir, ant, dipole)  - 

1  ATan2 (xData(dir , ant , dipole , dopp , 2) , 

2  xData(dir, ant , dipole , dopp , 1) ) 

10004  continue 


c  Calculate  the  antenna- to -antenna  phase  differences, 
c 

pdl2(dir, dipole)  —  Phase(dir, 2 , dipole) -Phase (dir , 1 , dipole) 

If  (pdl2(dir .dipole)  .gt.  pi) 

1  pdl2 (dir .dipole)  -  pdl2(dir, dipole)  -  2*pi 

If  (pdl2(dir, dipole)  .It.  -pi) 

1  pdl2(dir .dipole)  -  pdl2(dir. dipole)  +  2*pi 

pd23 (dir .dipole)  -  Phase(dir. 3 .dipole) -Phase(dir, 2 , dipole) 
If  (pd23(dir .dipole)  .gt.  pi) 

1  pd23(dir .dipole)  -  pd23(dir. dipole)  -  2*pi 

If  (pd23(dir .dipole)  .It.  -pi) 

1  pd23(dir .dipole)  -  pd23(dir, dipole)  +  2*pi 


c 

c  Tests  #2,3,6.&7:  The  two  zenith  angles  derived  from  the  two  phase 
c  differences  for  each  dipole,  each  direction,  must  agree, 
c 

c  Each  time  through,  the  maximum  allowed 

c  zenith  angle  spread,  ZAW,  is  3*ZAWindow  -  ZASpread(dir) . 
c  The  actual  maxima  are  accumulated  in  ZASpread(dir ) . 


c  Each  cime  through,  the  actual  spread  is  added  to  ZASp read v d i r ) , 
c  which  is  the  only  measure  of  the  zenith-angle  spread  that  is 
c  saved  as  part  of  the  scatte.  ing-point  parameters, 
c 

c  Antenna  Pair  1-2: 
c 

thetal  =  asin( -pdl2 (dir , dipole)/pi ) 
c 

c  Antenna  Pair  2-3: 
c 

theta2  =  as in( -pd2 3  (dir  ,  dipole )  i ) 
c 

c  Are  the  two  zenith  angles  close  enough  together  to 
c  qualify  as  a  scattering  point? 

c  If  thSpread  is  greater  than  the  maximum  spread  allowed  (ZAW) , 
c  set  failflag-=l  and  get  out.  Otherwise,  possible  scattering  point, 
c  This  gives  rej ect (2 , 3 , 6 ,&7) . 
c 

thSpread  —  abs ( thetal- the ta2) 
if  (thSpread  .gt.  ZAW)  then 
index  -  (dir-l)*4  +  dipole  +  1 
rej ect( index)  -  reject(index)  +  1 
failflag  -  1 
go  to  90909 
endif 

c 

c  Possible  scattering  point;  we've  found  an  acceptably  small 
c  disagreement  (thSpread)  between  the  two  theta  values, 
c  Accumulate  thSpread  in  21ASpread(dir)  (which  will  become  two  of  the 
c  scattering-point  parameters),  and  locate  the  average  zenith  angle 
c  for  this  dir  and  dipole  at  the  middle  of  the  window, 
c 

ZASpread(dir)  -  ZASpread(dir)  +  thSpread 
thlDipole(dipole)  -  ( thetal-t-theta2)/2 
10098  continue 
c 

c  Tests  #4  and  #8;  Both  dipoles  have  separately  determined  zenith 
c  angles  for  one  direction.  Do  these  two  values  agree? 
c 

ZAW  -  3*ZAWindow  -  ZASpread(dir) 

if  (abs(thlDipole(l) -thlDipole(2) )  .gt.  ZAW)  then 
index  -  4*dir 

reject(index)  -  reject(index)  +  1 
failflag  -  1 
go  to  90909 
endif 

thConsensus  -  (thlDipole(l)-^thlDipole(2)  )/2 
thSpread  -  abs(thlDipole(l) -thlDipole(2) ) 

ZASpread(dir)  -  ZASpread(dir )  +  thSpread 
c 

c  Now  we  are  convinced  that  the  two  dipoles  together 
c  indicate  that  a  real  scattering  point  exist.  Before  we 
c  can  test  the  two  directions  together,  we  need  the  best 
c  possible  estimate  of  the  zenith  angles. 

c  We  use  the  1-3  antenna  pair  with  the  dipoles  combined  to  match 
c  the  transmit  polarization, 
c 

if  (TxPolarization  .eq.  '0')  then 


VA  -  cmplx(xdaCa(dLr . 1 , 1 , dopp , 1) , xdaca(dir , 1 , 1 , dopp , 2 ) ) 

1  +  sr:  .o*cmplx(xdata(dir , 1 , 2 . dopp , 1 ) , xdata(dir , 1 , 2 , dopp , 2 ) ^ 

VB  -  cmplx(xdata(dir , 3 , 1 , dopp , 1) , xdata(dir , 3 , 1 , dopp , 2 ) ) 

1  +  srmo*cmplx(xdata(dir , 3 . 2 , dopp , 1 ) , xdata ( dir , 3 , 2 , dopp , 2 ) ) 

elseif  (TxPolarization  .eq.  'X')  then 

VA  -  cmplx(xdata(dir , 1 , 1 , dopp , I ) , xdata(dir . 1 , 1 , dopp , 2 ) ) 

1  -  srmo*cmplx(xdata(dir , 1 , 2 , dopp , 1 ) , xdata ( dir , 1 , 2 , dopp , 2 ) ) 

VB  -  cmplx(xdata(dir , 3 , 1 , dopp , 1) , xdata (dir , 3 , 1 , dopp , 2 ) ) 

1  -  sriao*cmplx(xdata(dir ,  3 , 2  ,  dopp  ,  1 )  ,  xdata(dir  ,  3 , 2  ,  dopp  .  2  ) ) 

elseif  (TxPolarization  .eq.  'L')  then 

VA  -  cmplx(xdata(dir , 1 , 1 , dopp , 1) , xdata(dir , 1 , 1 , dopp , 2 ) ) 

1  +  cmplx(xdata(dir , 1 , 2 , dopp , 1) ,xdata(dir , 1 . 2 , dopp , 2 ) ) 

VB  -  cmplx(xdata(dir , 3 , 1 , dopp , 1) , xdata(dir , 3 , 1 , dopp , 2 ) ) 

1  +  cmplx(xdata(dir , 3 . 2 , dopp , 1) , xdata(dir , 3 , 2 , dopp , 2 ) ) 

else 

write  (*,*)  'TxPolarization  -  ' .TxPolarization 
write  (*,*)  'is  NOT  SUPPORTED  by  this  version  of  SPPM' 
go  to  90909 
endif 

Antenna  Pair  A*B  (-  1-3  with  polarization); 

VAr  -  real(VA) 

VAi  -  aimag(VA) 

VBr  -  real(VB) 

VBi  -  aimag(VB) 

if  ((abs(VAr)  .gt.  le-5)  .or.  (abs(VAi)  .gt.  le-5))  then 

PhaseA  -  Atan2(VAi ,VAr) 

else 

PhaseA  —  0 
endif 

if  ((abs(VBr)  .gt.  le-5)  .or.  (abs(VBi)  .gt.  le-5))  then 

PhaseB  -  Atan2 (VBi , VBr) 

else 

PhaseB  -  0 
endif 

pdAB  -  PhaseB-PhaseA 

If  (pdAB  .gt.  +pi)  pdAB  -  pdAB  -  2*pi 

If  (pdAB  .It.  -pi)  pdAB  -  pdAB  +  2*pi 

do  10007  ithree  -  -1,1 

sinTheta  -  - (pdAB+2*pi*ithree)/(2*pi) 

if  (abs(sinTheta)  .It.  1.0)  then 
thAB  -  as in (sinTheta) 

if  (abs(thAB-thConsensus)  .It.  ZAWindow)  then 
thetaf inal(dir)  -  thAB 
go  to  10099 


endif 


endif 


10007  continue 


c 

c  Test  #5  and  #9:  If  there  is  no  final  zenith  angle  in  adequate 
c  agreement  with  the  Consensus  zenith  angle,  then  you  fall  through 
c  to  here  and  leave  a  failure, 
c 

index  -  5  +  4*(dir-l) 
rej ect( index)  -  rejecc(index)  +  1 
failflag  -  1 
go  to  90909 
c 

10099  continue 


c  Test  #10:  Reject  if  no  real  altitude  is  possible, 
c 

arg  “  sin(thetafinal(l))**2+sin(thetafinal(2) )**2 
if  (arg  .ge.  1)  then 
reject(lO)  -  reject(lO)  +  1 
failflag  -  1 
go  to  90909 
endif 
c 

c  If  you  got  to  he.e,  it's  a  real  scattering  point,  and  the 
c  cardinal  zenith  angles  are: 
c 

ThetaEW  -  thetaf inal(l) 

ThetaNS  -  thetafinal(2) 
c 

c  these  will  get  rotated  by  45  degrees  in  the  main  program  if 
c  DataMode  -  3 . 
c 

90909  return 
end 
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E.vTEBPM  t  -  T 

c 

Subroutine  BSTEERM 
c 

c  Now  that  you've  found  the  point,  "steer"  the  full  array  Coward  ctic- 
c  point  and  determine  its  power  and  phase, 
c  May  7,  1990. 
c 

$  include : ' BsppM . inc ' 

$  include ; ' Header . inc ' 

complex  Vsteer(2) 
c 

c  Each  direction  and  dipole  is  steered  separately,  and  the  voltage 
c  amplitudes  and  phases  determined, 
c 

do  10002  dipole  -  1,2 
Vsteer (dipole)  -  0 
do  10001  dir  -  1,2 

delphi(dir)  -  2*pi*sin(thetafinal(dir) ) 
do  10001  ant  -  1,3 

if  (ant  .eq.  3  .and.  dir  .eq.  2)  go  to  10001 
Vsteer (dipole)  -  Vsteer (dipole) 

1  +  cmplx(l . 0*xdata(dir , ant , dipole , dopp , 1) , 

2  xdata(dir, ant , dipole , dopp , 2) ) 

3  *  cexp(+snno*AntLocation(ant)*delphi (dir) ) 

10001  continue 

Vx  -  Real(Vsteer(dipole)) 

Vy  -  Aimag(Vsteer (dipole) ) 

VAraplitude(dipole)  -  cabs(Vsteer(dipole) ) 

if  (VAmplitude (dipole)  -ge.  1)  then 

Faze(dipole)  -  ATan2(Vy,Vx) 

else 

Faze(dipole)  -  0 
endif 

10002  continue 

90909  return 
end 
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$Debug 


P  O  p,  p  Ti/ 


f  O  I 


C 

c 

c 

c 

c 

c 


Subroutine  BSORTM 

The  scattering-point  parameters  are  in  spptemp 
in  order  by  range,  but  only  roughly  by  altitude. 
This  subroutine  orders  them  by  altitude  and  virtes 
them  into  the  output  file,  SPPList. 


include : ' Bsppm. inc ' 
include ; ' Header . inc ' 


real*4  zlast 

integer*4  itop , ipoint , ipmin 

isort  -  1 

itop  -  sppnumber 

•  20001  zmin  -  999 

zlast  -  0 
c 

c  Look  through  all  the  points  to  find  the  smallest  altitude, 
c 

do  10001  ipoint  -  l,itop 

•  if  (spptemp( ipoint, 1)  .gt.  -990  .and. 

1  spptemp (ipoint,!)  .It.  zmin)  then 

zmin  -  spptemp ( ipoint, 1) 

ipmin  -  ipoint 

endif 

10001  continue 

if  (zmin  .It.  zlast)  WRITE  (*,*)  'PROBLEM!  zmin, ipmin, zlast 
zlast  -  zmin 


write  (3)  (spptemp(ipmin, parameter) , parameter-1 , 10) 
if  (itop  .gt.  1)  then 
c 

c  Replace  the  last  scattering  point  by  the  one  at  the  top. 
c 

do  10004  parameter-1 , 10 

spptemp (ipmin, parameter)  -  spptemp(itop, parameter) 

10004  continue 
c 

c  Repeat  until  they're  all  gone.  I  didn't  say  it  was  efficient. 


30001 


itop  -  itop-1 

go  to  20001 

endif 

return 

end 
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■,i  ■  r  '  M 

—  —  f  i-  - 


.11 : 


c 

c 

c 


BsppM . inc 


1 

2 

3 

U 

1 

2 


1 


common  /sppA/  sppterap(2500 , 10) 

Common  /sppB/  Data(2 , 3 , 2 , 256 , 2) , Phase ( 2 , 3 . 2 ) , Che ta( 3  5), 

delphi(2) , thetafinal(2) , ZASpread(2 ) ,  # 

Voltage (2,2) , VAmpl icude ( 2 ) , Power ( 2,2) ,Fa2e(2)  , 
pdl2(2.2) ,pd23(2.2) , reject (12) , thlDipole(2)  , 

AntLocation(5) . S ( 10) , xdaca( 2 ,3,2,256,2) 
common  /sppC/  dopp, failflag, jRange, rgl , rg2 ,TxPolarization, 

SumPower , SPPNumber , ThetaEW , The  caNS , ZAWindow , 
pi , concod, contor , srmo , cli gh t, Thresho Id, LP switch  # 

Complex*16  Voltage, srmo 

Real*8  pi ,xorig,yorig,xyangle , rotate , ThetaEW , The taNS 
Real*4  zmin, spptemp , Threshold, pi imit , S , xdata 
Integer*4  Data, reject 

Integer*4  ant , count , dipole , dir , dopp , failflag , parameter , pmin , 

point .pulse .quad, rgl , rg2 , spacing , SPPNumber  # 

Character*2  TxPolarization 


938 

89 

5 

3 

17 

31 

16 

Islote,  P.R. 

0001 

0003 

256 

3.17500E+06 
3. 17500E+06 
3.00000E-05 
1 . 02400E+02 
4.00000E+01 
40 
10 

l.OOOOOE-02 
+3.10000E+03 
3 .  OOOOOE+03 
0 
LI 

l.OOOOOE+05 

1111111111 

GRxxx 


SoundingNumber 

Year 

Month 

Day 

Hour 

Minute 

Second 

SiteName 

DataType 

DataMode 

FFTPts 

Freql  (Hz) 

Freq2  (Hz) 

PulseDuration  (seconds) 
FFTPeriod  (seconds) 
NumCohAve 
NumRangeGates 


NumRx 

PRP  (seconds) 
AltMin  (meters) 
AltStep  (meters) 
RxAttn 

RxPolarization 
TxPower  (Watts) 
RxMask 
TapeLabel 
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$Debug 

program  WindErr 

c 

.5:  ■>***-jlr***4.****************'*  •*****->*****->******■***■*  •*-'*-***'**-A^****-i^*-*->i->,i-*,V 


>lr  -> 

*  IDI  Wind-Calculation  Program;  MAPSTAR  Radar.  * 

*  Copyright  1990,  Holodyne  Limited  1986.  * 

*  All  Rights  Reserved.  * 

*  * 


****-**Tfc*******************************-******->*-*  •*•***■>****■*•  •*•*****■*■*•* 

c  April  8,  1991 

c 

c  This  program  will  calculate  129  wind  profiles 

c  for  a  single  scattering-point  parameter  file.  The  spread  due  to 

c  errors  in  the  calculation  are  determined  by  varying  the  range, 

c  the  Doppler  velocity,  and  the  E-W  and  N-S  zenith  angles.  The 

c  129  profiles  so  generated  are  examined  to  get  max  and  min  at 

c  each  altitude.  Files  generated  are  u.dat,  ubar.dat,  v.dat, 
c  vbar.dat,  w.dat,  and  wbar.dat,  which  are  for  plotting  the 
c  three  components  and  their  error  bars,  and  winderr.dat,  which 
c  contains  all  the  information  in  a  single  file, 
c 

c  The  scattering-point  parameters 
c  are  : 

c  1.  Altitude  (km), 

c  2.  Radial  velocity  (m/sec). 

c  3.  Zenith  angle  in  East-West  meridian  (degrees), 

c  4.  Zenith  angle  in  North-South  meridian  (degrees), 
c  5.  Voltage  amplitude  on  #1  Dipoles, 
c  6.  Phase  of  #1  Dipoles  (degrees), 
c  7.  Voltage  amplitude  on  #2  Dipoles, 
c  8.  Phase  of  #2  Dipoles  (degrees), 
c  9.  E-W  zenith-angle  spread, 

c  10.  N-S  zenith- angle  spread, 

c 

c  Explanation  of  easily-reprogrammed  parameters  (just  change  the  source - 
c  code  value  given  below: 

c  vHmax  is  the  largest  allowed  horizontal  velocity.  We  test  each  point 
c  against  Vmax  by  projecting  its  radial  velocity  into  the  horizontal 
c  plane,  and  reject  it  if  it's  bigger  than  vHmax. 
c  ThMaxV  is  the  largest  acceptable  radial  zenith  angle  for  w. 
c  ThMinV  is  the  smallest  acceptable  radial  zenith  angle  for  w. 
c  ThMaxH  is  the  largest  acceptable  radial  zenith  angle  for  u  and  v. 
c  ThMinH  is  the  smallest  acceptable  radial  zenith  angle  for  u  and  v. 
c  MinNumPts  is  the  minimum  number  of  points.  If  there  are  not  sufficient 
c  points,  that  altitude  is  skipped. 

c  NSigma  is  the  maximum  number  of  standard  deviations  from  the  fit  any 
c  individual  point  can  lie  without  being  rejected  from  the  velocity 

c  calculation. 

c  Zmin  is  the  bottom  altitude  for  which  winds  are  to  be  calculated, 
c 

c  WindErr  calls  SppFltr,  Header,  WFV,  and  WFH. 
c 

$ Include: 'Wind. Inc' 

$Include : 'Header. inc' 

dimension  umax(lOO) ,u0(100) ,umin(100) , 

1  vmax(lOO) , vO(lOO) , vmin(lOO) , 

2  wmax(lOO) ,w0(100) ,wmin(100) , scale (100) . 

3  Number(lOO) ,Uvar(100) ,Vvar(100) ,Wvar(100) 
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real*4  NuraSndgs , scale 
integer*4  jzMax 
pi  -  3.14159265 

vHmax  -  300 
ThMinV  -  0 
ThMaxV  -  10 
ThMinH  -  3 
ThMaxH  -  16 
MinH  -  5 
MinV  -  5 
Nsigma  -  3.0 
Zmin  -  60 
Zmax  -  120 
polarization  —  'o' 

Open  (1 , err-90909 , f ile— '  ' , status=' old' , form-'binary ' ) 
Open  (2 , err-90909 , file-' SppFltr .mbs ' , form-'binary' ) 
Call  SppFltr 
close  (1) 
rewind  (2) 

CALL  Headr* 

open  (1 , file-' WE2 . dat' ) 

do  10001  jz  -  1,100 

Z(jz)  -  float(jz-l)  +  Zmin 

Umax(jz)  -  -100 

Umin(jz)  -  +100 

uO(jz)  -  0 

Uvar(jz)  -  0 

Vmax(jz)  -  -100 

Vmin(jz)  -  +100 

vO(jz)  -  0 

Vvar(jz)  -  0 

Wmax(jz)  -  -10 

Wmin(jz)  -  +10 

wO(jz)  -  0 

Wvar(jz)  -  0 

Number (jz)  -  0 

scale(jz)  -  1 

if  (Z(jz)  .ge.  Zmax)  then 

jZmax  -  jz 

go  to  20301 

endif 

10001  continue 


20301  do  10501  jZinc  -  1,3 

if  (jZinc  .eq,  1)  then 

write  (*,*)  ' . ' 

elseif  (jZinc  .eq  2)  then 

write  (*,*)  ' . . ' 

else 

write  (*,*)  '  . .  .  ' 
endif 

write  (*,90008) 

90008  format  (lx,\) 

do  10301  idR  -  0,2 


dR 

-  idR*2.5 

if 

(idR 

eq. 

2)  dR  =  -2.5 

do 

10301 

idVr 

-  0,4 

if 

(idVr 

.eq. 

0)  dVrad  -  0 

if 

(idVr 

.eq. 

1)  dVrad  -  +0.23 

if 

(idVr 

.eq. 

2)  dVrad  -  -0.23 

if 

(idVr 

eq. 

3)  dVrad  -  +0.23 

if 

(idVr 

.eq. 

4)  dVrad  -  -0.23 

do 

10301 

idThEW  -  0,4 

do 

10301 

idThNS  -  0,4 

rewind  (2) 

iSum  -  idR  +  idVr  +  IdThEW  +  idThNS 
if  (((idR  .eq.  0)  .or.  (idVr  .eq.  0)  .or. 

1  (idThEW  .eq.  0)  .or.  (idThNS  .eq.  0))  .and. 

2  iSum  .gt.  0)  go  to  10301 

index  -  (idVr-l)*16  +  ( idThEW- 1) *4  +  idThNS 
if  (index/64  .It.  1)  then 
write  (*,90005) 

90005  format  ('.',\) 
else 

write  (*,90006) 

90006  format  ( '  .  '  ) 
write  (*,90007) 

90007  format  (lx,\) 
endif 

QuitFlag  -  0 
jzW  -  jZinc 
do  10101  jz  -  l,jZmax 
u(jz)  -  0 
v(j2)  -  0 
w(jz)  -  0 
10101  continue 

read  (2 , err-90909 , end-20203)  (line(parameter) , parameter-1 , 10) 

************************************************************************ 
*  Return  to  here  for  new  altitude. 

ic'k'k^'k'kicit-krk-kic'k'kif'k'k'k'^icicic'kie'kieic'kiticiciCieicic'kic^icicicicicie'kicitic'k'k'k'kik-kicicicir-kic'kicit'kicie'kicicicic-k 

C 

20201  NumPts  -  0 

read  (2 , err-90909 , end-20203)  (line(parameter) , parameter-1 , 10) 

20202  if  (line(l)+dR*scale(jzW)  .le.  Z(jzW)-1.5)  then 

read  (2, err-90909, end-20203)  (line(parameter) , parameter-1, 10) 

go  to  20202 

endif 

if  (line(l)+dR*scale(jzW)  .gt.  Z(jzW)+1.5)  then 
if  ((NumPts  .It.  MinV)  .or.  (NumPts  .It.  MinH))  go  to  20206 
go  to  20204 
endif 

TestFlag  -  1 

if  (NumPts  .eq.  5000)  then 

write  (*,*)  'Thanks  anyhow,  but  Ive  already  got  5000  points.' 

TestFlag  -  0 

endif 

if  (TestFlag  .eq.  1)  then 
NumPts  -  NumPts  +  1 
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do  1020L  parameter  =  1,10 
if  (parameter  .eq.  2)  then 
if  (idVr  . le  2)  then 
if  (line(2)  .It.  0)  spp(N'amPts ,  2) 
if  (line(2)  .gt.  0)  spp(NumPts . 2 ) 
else 

spp(NumPts,2)  -  line(2)  +  dVrad*scale ( j zW) 
endif 


line ( 2 ) 
line (2) 


dVrad*scale ( j  zW) 
dV rad* sc ale ( j  zW) 


elseif  (parameter  .eq.  3)  then 
if  (idThEW  .eq.  0)  then 
spp(NumPts , 3)  -  line (3) 


elseif  (idThEW  .eq. 
if  (line(3)  .It.  0) 
if  (line (3)  .ge.  0) 
elseif  (idThEW  .eq. 
if  (line(3)  .It.  0) 
if  (line(3)  .ge.  0) 
elseif  (idThEW  .eq. 


1)  then 
spp(NumPts , 3) 
spp(NumPts , 3) 

2)  then 
spp(NumPts , 3) 
spp(NumPts , 3) 


3 )  then 

spp(Numpts, 3)  -  line(3)  +  line(9)*scale(jzW)/2 
elseif  (idThEW  .eq.  4)  then 

spp(NumPts,3)  -  line(3)  -  line(9)*scale(jzW)/2 
endif 


line(3)  -  line(9)*scale(jzW)/2 
line(3)  +  line (9)*scale ( j zW)/2 

line(3)  +  line(9)*scale( jzW)/2 
line(3)  -  line(9)*scale(jzW)/2 


elseif  (parameter 
if  (idThNS  .eq. 
spp(NumPts , 4)  — 
elseif  (IdThNS 
if  (line(4)  .It 
if  (line(4)  .ge.  0) 
elseif  (idThNS  .eq. 
if  (line(4)  .It.  0) 
if  (line(4)  .ge.  0) 
elseif  (idThNS  .eq. 


eq.  4)  then 
0)  then 
line(4) 
eq.  1)  then 
0)  spp(NumPts,4) 
spp(NumPts,4) 
2 )  then 
spp(NumPts ,4) 
spp(NumPts ,4) 


3 )  then 

spp(Numpts  ,4)  -  line(4)  +  line(10)*scale(jzW)/2 
elseif  (idThNS  .eq.  4)  then 

spp(NumPts,4)  -  line(4)  -  line(10)*scale(jzW)/2 
endif 


line (4) -line(10)*scale( jzW) /2 
line(4)+line(10)*scale(jzW)/2 

line(4)+line(10)*scale( jzW) /2 
line (4) -line(10)*scale( izW)/2 


else 

spp(NumPts,i;ai.-ameter)  -  line  (parameter) 
endif 

10201  continue 
endif 

read  (2 , err—90909 ,end— 20203)  ( line (parameter) ,pararaeter=l , 10) 
go  to  20202 

20203  quitflag  -  1 

20204  Fitflag  -  1 
c 

c  Fit  the  scattering  points  in  this  window  with  a  3 -vector, 
c 

20205  CALL  WFV 

if  (Fitflag  .eq.  0)  then 

c  write  (*,*)  'Vertical  Failure  at  ',jzW,Z(jzW) 
go  to  20206 
endif 


108 


Call  WFH 


if  (Fitflag  .eq.  0)  then 

c  write  (*,*)  'Horizontal  Failure  at  ',jzW,Z(j2W) 

else 

if  ((idR  .eq.  0)  .and.  (idVr  .eq.  0)  .and. 

1  (idThEW  .eq.  0)  .and.  (idThNS  .eq.  0))  then 
if  (NumPts  . eq .  0)  then 
scale(jzW)  —  1 
else 

scale(jzW)  -=  l/sqrt(  float (NumPts)/3 . 0) 

endif 

endif 

c  write  (*,90001)  idR, idVr, idThEW, idThNS, Z(jzW) ,u(jzW) .v(jzW) ,w(jzU) 
write  (1,90004)  Z(jzW) ,u(jzU) ,v(jzW) ,w(jzW) 
endif 

90001  format  (lx ,4( i2 , lx) , f4 .0 , 2(lx, f6 . 1) , lx. f 5 . 1) 

9C004  format  (lx, f4 .0 , 2(lx , f6 . 1) , lx . f 5 . 1) 

90002  format  (lx, 4(el2 . 4 , lx) ) 
c 

c  If  it's  not  time  to  quit,  increment  jzW  and  go  read  the  next  points, 
c 

20206  if  (QuitFlag  .eq.  0)  then 
jzW  -  JzW  +  3 

if  (JzW  .gt.  jZmax)  go  to  10301 

read  ( 2, err-90909, end-20203)  (line(parameter) , parameter-1 , 10) 

go  to  20201 

endif 

10301  continue 
10501  continue 
90909  close  (2) 

rewind  (1) 

20401  read  (1,90004, end-20402)  Zx,ux,vx,wx 
ijz  -  Zx-Zmin+1 

UO(ijz)  -  UO(ijz)  +  ux 
VO  (ijz)  -  VO  (ijz)  +  vx 
WO(ijz)  -  WO (ijz)  +  wx 
Number(ijz)  -  Number(ijz)  +  1 
go  to  20401 

20402  do  10601  jz  -  l,jzMax 

if  (Number(jz)  .gt,  0)  then 
UO(jz)  -  U0(jz)/Number(jz) 

VO(jz)  -  V0( jz)/Number(jz) 

WO(jz)  -  W0(jz)/Number(jz) 
endif 

10601  continue 

rewind  (1) 

20403  read  (1 , 90004 , end-20404)  Zx,ux,vx,wx 
ijz  —  Zx-Zmin+1 

Uvar(ijz)  -  Uvar(ijz)  +  abs(u0(ijz) -ux) 

Vvar(ijz)  -  Vvar(ijz)  +  abs(v0(ijz) -vx) 

Wvar(ij2)  -  Wvar(ijz)  +  abs(w0(ijz) -wx) 
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go  to  20403 


20404  do  10602  jz  “  l.jzMax 

if  (Nuinber(jz)  .gt.  0)  then 
Uvar(jz)  -  Uvar ( jz)/Number ( j z) 

Vvar(jz)  -  Vvar( jz)/Number(jz) 

Wvar(jz)  -  Wvar(jz)/Nujnber(jz) 
end  if 

10602  continue 

20405  CLOSE  (1) 

open  (1 , f ile-' u. dat ' ) 

open  (2 , f ile-' ubar . dat ' ) 

do  10401  jz  -  l.jzMax 

if  (Nuniber(jz)  .gt.  0)  then 

uminCjz)  -  uO(jz)  -  2*uvar(jz) 

umax(jz)  -  uO(jz)  +  2*uvar(jz) 

if  (umin(jz)  .It.  -100)  umin(jz)  -  -100 

if  (uniax(jz)  .gt.  +100)  uj3iax(jz)  -  +100 

write  (1,*)  z(jz).u0(jz) 

write  (2,*)  z(jz) ,umin(jz) 

write  (2,*)  z(jz)  ,uniax(jz) 

write  (2,*)  -10,0 

else 

write  (1,*)  -10,0 
endif 

10401  continue 
close  (1) 
close  (2) 

open  (1 , file-' V. dat' ) 

open  (2 , file-' vbar . dat' ) 

do  10402  jz-l,jzMax 

if  (Number(jz)  .gt.  0)  then 

vinin(jz)  -  vO(jz)  -  2  *  ar(jz) 

vmax(jz)  -  vO(jz)  +  2*v.  '^jz) 

if  (vmin(jz)  .It.  -100)  vit  -  -100 

if  (vmax(jz)  .gt.  +100)  vmax  +100 

write  (1,*)  z(jz) ,vO(jz) 

write  (2,*)  z(jz) ,vmin(jz) 

write  (2,*)  z(Jz)  ,vinax(jz) 

write  (2,*)  -10,0 

else 

write  (1,*)  -10,0 
endif 

10402  continue 
close  (1) 
close  (2) 

open  (l.file-'w.dat' ) 
open  (2, file- 'wbar.dat') 
open  (11 , file-' winderr.dat' ) 

do  10403  jz-l,jzMax 
if  (Number(jz)  .gt.  0)  then 
winin(jz)  -  wO(jz)  -  2*wvar(jz) 
winax(jz)  -  wO(jz)  +  2*wvar(jz) 
if  (winin(jz)  .It.  -10)  wniin(jz)  -  -10 
if  (wniax(jz)  .gt.  +10)  winax(jz)  -  +10 

110 


write  (1,*)  z(jz) , wO( jz)*10 
write  (2,*)  z( jz) ,wmin( jz)*10 
write  (2,*)  z  ( j  z)  ,  winax(  j  z)*10 
write  ( 2 , *)  0,-10 

if  (z(jz)  . ge .  Zmin)  then 
write  (11,90003)  z(jz), 

1  uniin(  j  z)  ,u0(  j z) ,  Limax(  j  z) 

2  vmin( jz) ,v0(jz) ,vmax( jz) 

3  winin( jz)  ,w0(jz)  ,wniax(jz) 
endif 

else 

write  (1,*)  -10,0 
endif 

10403  continue 
close  (1) 
close  (2) 
close  (11) 

90003  format  (lx, 10(f7 . 2) ) 
c  call  BellSub 

91919  End 


subroutine  SppFltr 

dimension  spp(lO) 

real*4  Zmin , Zmax .ThMin.ThMax . ZA 

character*!  polarization 

integer*4  parameter .Nraw.Nfltr 

pi  -  3.14159265 

write  (*,*)  'SppFltr  expects  the  input  (.mbs)  file  to  be  on  the  co 
Immand  1 ine . ' 
write  (*,*) 

1  'The  filtered  file  will  be  written  to  SppFltr . mbs . ' 

Zmin  -  60 
Zmax  -  120 
ThMin  -  0 
ThMax  -  16 
VRmin  -  -60 
VRmax  -  60 
vHmax  -  300 
Nraw  -  0 
Nfltr  -  0 
polarization  -  'o' 

20001  read  ( 1 , end-20002)  (spp(parameter) , parameter-1 , 10) 

Nraw  -  Nraw  +  1 

*********************************************************************** 
c  Filter  Section 

c 

c  Filters  go  here.  If  fail,  go  to  20001. 
c 

if  (spp(l)  .It.  zmin  .or.  spp(l)  .gt.  zmax)  go  to  20001 
if  (spp(2)  .eq.  0)  go  to  20001 

if  (spp(2)  .It.  VRmin  .or.  spp(2)  .gt.  VRmax)  go  to  20001 
sinZA  -  sqrt(sin(spp(3)*pi/180)**2+sin(spp(4)*pi/180)**2) 
if  (sinZA  .ge.  1)  go  to  20001 
if  (sinZA  .gt.  le-3)  then 

if  (abs(spp(2)/sinZA)  .gt.  vHmax)  go  to  20001 
endif 

ZA  -  (180/pi)*asin(sinZA) 

if  ((ZA  .It.  ThMin)  .or.  (ZA  .gt.  ThMax))  go  to  20001 
c 

c  Linear  polarization  filter  (removes  linearly  polarized  points): 
c 

if  ((polarization  .eq.  'o')  .or.  (polarization  .eq.  'x')  .or. 

1  (polarization  .eq.  'c'))  then 

if  (abs(spp(6) -spp(8))  .It.  45)  go  to  20001 
if  (  (abs(spp(6) -spp(8))  .gt.  135)  .and. 

1  (abs(spp(6) -spp(8))  .It.  225)  )  go  to  20001 

if  (  (abs(spp(6) -spp(8))  .gt.  315)  .and. 

1  (abs (spp(6) -spp(8) )  .It.  360)  )  go  to  20001 

endif 
c 
c 

c  Ordinary  polarization  filter  (removes  ordinary  points) : 
c 

if  ((polarization  .eq.  '1')  .or.  (polarization  .eq.  'x'))  then 
if  (spp(6) -spp(8)  .gt.  45  .and. 

1  spp(6) -spp(8)  .It.  135  )  go  to  20001 
if  (spp(6) -spp(8)  .gt.  -315  .and. 

1  spp(6) -spp(8)  .It.  -225  )  go  to  20001 
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endlf 


c 

c 

c 

c 


Extraordinary  polarization  filter  (removes  extraordinary  points): 


if 

( (polarization 

.eq. 

'1') 

.  or . 

(po 

larizacion 

if 

(spp(6) -spp(8) 

■gc. 

-135 

.  and . 

spp(6) -spp(8) 

.  It. 

-45  ) 

go 

to 

20001 

if 

(spp(6) -spp(8) 

■gc. 

225 

and . 

spp(6) -spp(8) 

•  It. 

315  ) 

go 

to 

20001 

endif 


c 

***************************************************************************** 


20002 


Nfltr  -  Nfltr  +  1 

write  (2)  (spp(parameter) ,parameter=l 
go  to  20001 

write  (*,*)  ‘Points  in,  points  out  - 

return 

end 


10) 

, Nraw , Nfltr 
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c 


vM  r  w 


vr 


$Debug 

c 

^'k'k':k'k-^'k'k'k'^'K'ir'k'k'kie'kiK'kicicicic'kicicic'icrk'k'Jc-kicrkicicifici['ki^'kit^±icic-^ic:kif'kikiciciric'kic-kicic:kii^icic'k-k'k^ 
Subroutine  WFV 

Tt  * -it  *'**■*•«■★**★*★*★*★**★★*:***★***★  *Tt  "it  ^ -it -it -A- -jt  it  it 

c 

C  THIS  SUBROUTINE  CALCULATES  the  vertical  WINDS  FROM  MAPSTaF  SPPs . 

C  August  17,  1990 

c 

$  Inc lude : 'Wind . Inc ' 

$ Include : ' Header . inc ' 

Dimension  a(3 , 3) .WindV(3) 

Real*4  Sigma, SigmaLast 
integer*4  flag.iZA 
pi  -  3.14159265 
Do  10101  la  -  1,3 
WindV(la)  -  0 
Do  10101  ib  -  1,3 
A( ia , ib)  -  0 
ICIOl  Continue 

NPV  -  NumPts 

do  10201  point  -  1, NumPts 
iwtv(point)  -  1 

sinZA(point)  -  sqrt(sin(spp(point , 3)*pi/180)**2 
1  +  sin(spp(point,4)*pi/180)**2) 

if  ( (sinZA(point)  .It.  sin(ThMinV*pi/180) )  .or. 

1  (sinZA(point)  .gt.  sin(ThMaxV*pi/180) ) )  then 
iwtv(point)  -  0 
NPV  -  NPV  -  1 
if  (NPV  .It.  MinV)  then 
FitFlag  —  0 
go  to  90909 
endif 
endif 

CosL(point)  -  Sin(spp(point, 3)*pi/180) 

CosM(point)  -  Sin(spp(point,4)*pi/180) 

CosN(point)  -  sqrt(l  -  CosL(point)**2  -  CosM(point)**2) 

10201  continue 

SigmaLast  —  le8 
20001  flag  -  0 

Do  10301  point  -  1, NumPts 
if  (iwtv(point)  .eq.  0)  go  to  10301 
A(l,l)  -  A(l,l)  +  CosL(point)**2 

A(l,2)  -  A(l,2)  +  CosL(point)*CosM(point) 

A(l,3)  -  A(l,3)  +  CosL(point)*CosN(point) 

Ail. 2)  -  Ail, 2)  +  CosM(point)**2 

A(2,3)  -  A(2,3)  +  CosM(point)*CosN(point) 

A(3.3)  -  A(3,3)  +  CosN(point)**2 

WindV(l)  -  WindV(l)  +  SPP(point, 2)*CosL(point) 

WindV(2)  -  WindV(2)  +  SPP(point , 2)*CosM(point) 

WindV(3)  -  WindV(3)  +  SPP(point, 2)*CosN(point) 

10301  Continue 

A(2,l)  -  A(l,2) 

A(3,l)  -  A(l,3) 

A(3,2)  =  A(2,3) 

det  =  a(l,l)*a(2,2)*a(3,3)  +  2*a(l , 2)*a(l , 3)*a(2 , 3)  - 
1  a(l,l)*a(2,3)**2  -  a(2 , 2)*a(l ,  3)**2  -  a(3 , 3)-va(l ,  2)**2 
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(abs(dec)  .It.  l.Oe-7)  then 
write  (*.*)  'WtV:  no  solution' 

Fitflag  -  0 
go  to  90909 
endif 

u(jzW)  -  (WindV(l)*fa(2,2)*a(3,3)-  a(2.3)**2)  + 

1  WindV(2)*(a(2.3)*a(l,3)  -  a(l , 2)*a(3 , 3) )  + 

2  WindV(3)*(a(1.2)*a(2,3)  -  a(l . 3)*a(2 , 2) ) )/det 
v(jzW)  -  (WindV(l)*(a(2.3)*a(1.3)  -  a ( 1 , 2 ) *a ( 3 , 3 ) )  + 

1  WindV(2)*(a(l,l)*a(3,3)  -  a(l,3)**2)  + 

2  WindV(3)*(a(1.3)*a(1.2)  -  a(l . l)*a(2 , 3) ) )/det 
w(jzU)  -  (Wind"(l)*(a(l,2)*a(2.3)  -  a(l , 3)*a(2 , 2) )  + 

1  WindV(2)*(a(1.2)*a(1.3)  -  a(l . l)*a(2 , 3) )  + 

2  WindV(3)*(a(l.l)*a(2,2)  -  a(  1 , 2)’<^*2)  )/det 
c 

c  Calculate  the  Standard  Deviation  (Sigma) 
c 

ErrorSum  -  0 

Do  10401  point  -  l.NumPts 
if  (iwtv(point)  .eq.  0)  go  to  10401 
dvr(point)  -  spp(point,2)  -  u(jzW)*CosL(point) 

1  -  v( jzW)*CosM(point)  -  w(jzW)*CosN(point) 

ErrorSum  -  ErrorSum  +  dvr(point)**2 
10401  Continue 

Sigma  -  sqrt(ErrorSum/NPV) 

Do  10501  point  -  l.NumPts 

if  (iwtv(point)  .eq.  0)  go  to  10501 

if  (abs(dvr(point) )  .gt.  NSigma*Sigma)  then 

iwtv( point)  -  0 

flag  -  1 

NPV  -  NPV  -  1 

if  (NPV  .It.  MinV)  then 

FitFlag  —  0 

go  to  90909 

endif 

endif 

10501  Continue 

if  (flag  .eq.  0)  go  to  20002 
if  (flag  .eq.  1)  then 

if  (Sigma  .ge.  0 . 999*SigmaLast)  go  to  20002 
if  (Sigma  .le.  0.01)  go  to  20002 
SigmaLast  -  Sigma 
go  to  20001 
endif 
c 

c  good  velocity, 
c 

20002  if  (  (abs(u(jzW))  .gt.  vHmax)  .or. 

1  (abs(v(jzW))  .gt.  vHmax)  .or. 

2  (abs(w(jzW))  .gt.  vHmax/20)  )  then 

c  write  (*,*)  ' jzw,NuraPts,u,v,w  -  ' 

c  write  (*,*)  jzw,NumPts,u(jzw) ,v(jzw) ,w(jzw) 

FitFlag  -  0 
go  to  90909 
endif 


90909  Return 


End 
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•'  r  H  .  i  I. 

c 

$Debug 

c 

****■**********************■**********■***•*■**•******■*********■*******->:*->  *-;t 

Subroutine  WFH 

**•*****•**■***■************■***■»**•*****'*•*************'*■*■***■*******,(:***->**■> 

C 

C  THIS  SUBROUTINE  CALCULATES  horizontal  WINDS  FROM  MAPSTAR  SPPs. 

C  August  17,  1990 

c 

$ Include : ' Wind. Inc ' 

$ Include ; ' Header . inc ' 

Dimension  H(3 , 3) ,Wind(3) 

Real*4  Sigma , SigmaLast 
integer*4  flag.iZA 
pi  -  3.14159265 
Do  10101  la  -  1.3 
Wind(ia)  -  0 
Do  10101  ib  -  1.3 
H(ia, ib)  -  0 

10101  Continue 

do  10102  iDir  -  1,3 
PPCnt(iDir)  -  0 
do  10102  ii  -  1,17 
Numrad( ii , iDir)  -  0 
vrad(ii, iDir)  -  0 

10102  Continue 
NPH  -  NumPts 

do  10201  point  -  1, NumPts 
iwth(point)  -  1 

if  ( (sinZA(point)  .It.  sin(ThMinH*pi/180) )  .or. 

1  (sin21A( point)  .gt.  sin(ThMaxH*pi/180) ) )  then 

iwth(point)  -  0 
NPH  -  NPH  -  1 
if  (NPH  . It .  MinH)  then 
FitFlag  -  0 
go  to  90909 
endif 
endif 

CosL(point)  -  Sin(spp(point, 3)*pi/180) 

CosM(point)  -  Sin(spp(point,4)*pi/180) 

CosN(point)  -  sqrt(l  -  CosL(point)**2  -  CosM(point)**2) 

10201  continue 

SigmaLast  -  le8 
20001  flag  -  0 

Do  10301  point  -  1, NumPts 
if  (iwth(point)  .eq.  0)  go  to  10301 
H(l,l)  -  H(l,l)  +  CosL(point)**2 
H(l,2)  -  H(l,2)  +  CosL(point)*CosM(point) 

H(2,2)  -  H(2,2)  +  CosM(point)**2 

Wind(l)  -  Wind(l)  +  SPP(point, 2)*CosL(point) 

1  -  CosL(point)*w( j zW) 

Wind(2)  -  Wind(2)  +  SPP(point , 2)*CosM(point) 

1  -  CosM(point)*w( j zW) 

10301  Continue 

H(2,l)  -  H(1.2) 

det  -  H(1,1)*H(2,2)  -  H(l,2)**2 

If  (abs(det)  .It.  l.Oe-7)  then 
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write  (*,*)  no  solution' 

Fitflag  =  0 
go  to  90909 
endif 

u(jzW)  =  (wind(l)*H(2,2)  -  wind( 2)*H(1 , 2 ) )/det 
v(jzW)  -  (H( 1 , l)*wind(2)  -  H( 1 , 2 )*wind( 1 ) )/det 
c 

c  Calculate  the  Standard  Deviation  (Sigma) 
c 

ErrorSum  =  0 

Do  10401  point  =  l.NumPts 
if  (iwth(point)  .eq.  0)  go  to  10401 
dvr(point)  -  spp(point,2)  -  u(jzW)*CosL(point) 

1  -  v(j zW)*CosM(point)  -  w(jzW)*CosN(point) 

ErrorSum  -  ErrorSum  +  dvr (point)**2 
10401  Continue 

Sigma  -  sqrt(ErrorSum/NPH) 

Do  10501  point  -  l.NumPts 

if  (iwth(point)  .eq.  0)  go  to  10501 

if  (abs (dvr(point) )  .gt.  NSigma*Sigma)  then 

iwth(point)  -  0 

flag  -  1 

NPH  -  NPH  -  1 

if  (NPH  .It.  MinH)  then 

FitFlag  -  0 

go  to  90909 

endif 

endif 

10501  Continue 

if  (flag  .eq.  0)  go  to  20002 
if  (flag  .eq.  1)  then 

if  (Sigma  .ge.  0 . 999*SigmaLast)  go  to  20002 
if  (Sigma  .le.  0.01)  go  to  20002 
SigmaLast  -  Sigma 
go  to  20001 
endif 
c 

c  good  velocity, 
c 

20002  if  (  (abs(u(jzW))  .gt.  vHmax)  .or. 

1  (abs(v(jzW))  .gt.  vHmax)  .or. 

2  (abs(w(jzW))  .gt.  vHmax/20)  )  then 

FitFlag  -  0 

go  to  90909 
endif 

WD  -  (180/pi)*atan2(v(jzW) ,u(jzW) ) 
do  10601  point  -  l.NumPts 

if  ((iwtv(point)  .eq.  1)  .or.  (iwth(point)  .eq.  1))  then 
Theta  -  (180/pi)*atan2(CosM(point) , CosL(point) ) 
diff  -  Theta-WD 

if  (diff  .It.  -180)  diff  -  diff  +  360 
if  (diff  .gt.  +180)  diff  -  diff  -  360 

if  ((abs(diff)  .It.  45)  .or.  (abs(diff)  .gt.  135))  then 
iDW  -  1 
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else 
iDW  -  2 
end  if 

PPCnt(iDW)  -  PPCnt(iDW)  +  1 
PPCnt(3)  -  PPCnt(3)  +  1 

• 

dvr(point)  -  spp(poLnt,2)  -  u( j zW)*CosL(point) 

1  -  v( j zW)*CosM(point)  -  w(jzW)*CosN(poinc) 

ZA  -  (180/pi)*asin(sinZA(point) ) 
iZA  “  inC(ZA)  +  1 

%  if  (iza  .  eq .  17)  iZA  *=  16 

vrad(iZA, iDW)  -  vrad(iZA, iDW)  +  dvr (point) **2 
vrad(iZA,3)  -  vrad(iZA,3)  +  dvr (point)**2 
c  vrad( iZA, iDW)  -  vrad( iZA, iDW)  +  abs(dvr (point) ) 

c  vrad(iZA,3)  -  vrad(iZA,3)  +  abs(dvr(point) ) 

NumradliZA,  iDW)  —  Nuinrad(i21A,  iDW)  +  1 
#  Numrad(iZA,  3)  =■  Nuinrad(iZA,  3)  +  1 

endif 

10601  continue 


do  10702  iDir  -  1,3 
if  (PPCnt(iDir)  .gt.  0)  then 

•  do  10701  ialpha  -  1,16 

if  (Numrad( ialpha , iDir)  .eq.  0)  go  to  10701 

vrad( ialpha, iDir)  -  sqrt(vrad( ialpha , iDir)/Nunirad( ialpha , iDir ) ) 
c  vrad( ialpha, iDir)  «  vrad(ialpha, iDir)/Nuinrad(ialpha, iDir) 

10701  continue 
endif 

#  10702  continue 


90909  Return 
End 
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conunon  /windl/  Spp(5500,10) 

conunon  /wind2/  z ( 130) , u( 130) . v( 130) , w( 130) . TRP( 130) , 

1  rej (7) .line(lO) ,sinZA(5500) ,Widch(130) . 

2  iwtv( 5500) , iwth( 5500) , rmsdvr ( 130 ,3).PPCnt(3), 

4  CosL(5500) ,CosM(5500) ,CosN(5500) ,dvr(5500) , 

5  Nunirad(17 , 3) ,  vrad(17 , 3)  ,  PPslope (2 ) 

common  /wind3/  pi,vHmax,ThMaxH,ThMinH,ThMaxV,ThMinV,MinH,MinV. 

1  Nsigma . Single .Test Flag .polarization, 

1  j  zW.QuitFlag.NumPts , interval , infile , out file , 

2  inpath , outpath , emonth , eday , ehour , eminute , NPH , NPV , NPVO , 

3  slope , intercept , FitFlag 

real*4  pi , vHmax , ThMax , ThMaxV , dz , z , u, v, w.TRP , SigmaFinal , sinZA , 

1  line , rmsdvr , CosL, CosM, CosN , dvr , slope , intercept , 

2  vrad, PPslope 

integer*4  QuitFlag.rej , jzW, parameter , Single .TestFlag, 

1  point, NumPts, interval, BigTime , NPV, NPVO .Test flag, FitFlag, 

2  emonth , eday , ehour , eminute , MinH , MinV , 

3  Numrad.PPCnt 
character*10  outpath 
character*40  inf ile , outf ile 
character*9  inpath 
character*!  polarization 
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Wind 


$Debug 


program  Wind 
c 

******************************************************************************* 
*  -> 

*  IDI  Wind-Calculation  Program;  MAPSTAR  Radar.  * 

*  Copyright  1990,  Holodyne  Limited  1986.  * 

*  All  Rights  Reserved.  * 

*  >k- 

************************************************************Tt*-A-**lt**** 


c  This  program  will  calculate  wind  profiles  in  3-km  steps,  with 
c  smoothing,  for  a  single  scattering-point  parameter  file  from  SppM 
c  or  a  group  of  files  from  SGroup.  The  scattering-point  parameters 
c  are  : 

c  1.  Altitude  (km), 

c  2.  Radial  velocity  (m/sec). 

c  3.  Zenith  angle  in  East-West  meridian  (degrees), 

c  4.  Zenith  angle  in  North-South  meridian  (degrees), 
c  5.  Voltage  amplitude  on  #1  Dipoles, 
c  6.  Phase  of  #1  Dipoles  (degrees), 
c  7.  Voltage  amplitude  on  #2  Dipoles, 
c  8.  Phase  of  #2  Dipoles  (degrees), 
c  9.  E-W  zenith-angle  window, 

c  10.  N-S  zenith -angle  window, 

c 

c  Explanation  of  easily-reprogrammed  parameters  (just  change  the  source- 
c  code  value  given  below: 

c  vHmax  is  the  largest  allowed  horizontal  velocity.  We  test  each  point 
c  against  Vmax  by  projecting  its  radial  velocity  into  the  horizontal 
c  plane,  and  reject  it  if  it's  bigger  than  Vmax. 
c  ThMaxV  is  the  largest  acceptable  radial  zenith  angle  for  w. 
c  ThMinV  is  the  smallest  acceptable  radial  zenith  angle  for  w. 
c  ThMaxH  is  the  largest  acceptable  radial  zenith  angle  for  u  and  v. 
c  ThMinH  is  the  smallest  acceptable  radial  zenith  angle  for  u  and  v. 
c  MinNumPts  is  the  minimum  number  of  points.  If  there  are  not  sufficient 
c  points,  that  altitude  is  skipped. 

c  NSigma  is  the  maximum  ntunber  of  standard  deviations  from  the  fit  any 
c  individual  point  can  lie  without  being  rejected  from  the  velocity 
c  calculation. 

c  Wind  calls  Header,  inname,  outname,  WFV,  WFH,  and  PhFit. 
c 

c  April  16,  1991. 
c 

$Include: 'Wind. Inc' 

$ Include : ' Header . inc ' 

character*!  ansi , ans2 , polarization 
real  NumSndgs,Rate,Zmin,Zmax 
pi  -  3.14159265 
polarization  -  'a' 

VrMax  -  300 
Zmin  -  78 
Zmax  -  102 
jzW  -  26 
jzWmax  =  34 
c 

c  Set  ipick  -  0/1  to  disable/enable  the  vHmax  filter. 


vHmax  =  +300 


ThMinV  -  0 
ThMaxV  -  10 
ThMinH  -  3 
ThMaxH  -  16 
ThMin  -  0 
ThMax  -  16 

MinH  -  5 
MinV  -  5 
Nsigma  -  3.0 

CALL  Header 

delZ  -  AltStep*le-3/2 

******************************************************************************* 

*  Coiamuriicate  with  User 

* 

20001  write  (*,*)  'Single  file.  Group,  or  Loop?  (s/g/L)' 
read  (*,'(a)')  ansi 
loop  -  0 

if  (ansi  .eq.  'L')  then 
ijk  -  1 
loop  -  1 
go  to  20009 

elseif  (ansi  .eq.  's')  then 
write  (*,*)  'Input  file  name?' 
read  (*,'(a)')  infile 
outfile  -  'Wind.dat' 

Single  -  1 

elseif  (ansi  .eq.  'g')  then 
Single  -  0 

open  (3 , file-'wind. txt' ) 
write  (*,*)  'Use  Default  Values?  (y/n) ’ 
read  (*,'(a)')  ans2 
if  (ans2  .eq.  'y')  then 
c 

c  user  must  set  these  values  before  compilation  to  use  the  default  option 
c 

interval  -  60 
inpath  -  'e:\lhour\' 
outpath  -  'c:\wlhour\' 

Month  -  4 
Day  -  5 
Hour  “  14 
Minute  -  00 
eMonth  -  4 
eDay  -  11 
eHour  -  16 
eMinute  -  0 
c 

ccccccccccccccccccccccccccccccccccccccccccccccccccc 

else 

write  (*,*)  'Grouping  interval  (minutes)?' 
read  (*,*)  interval 

write  (*,*)  'Center  time  of  first  file  (month, day, hr , min)? ' 
read  (*,*)  Month, Day, Hour, Minute 

write  (*,*)  'Time  of  last  file  (month, day , hr , min) ? ' 
read  (*,*)  eMonth, eDay, eHour, eMinute 
write  (*,*)  'Input  path  (9  characters)' 


read  (*,'(a)')  Lnpath 

write  (*,■*■)  'Output  path  (10  characters)' 
read  (*,'(a)')  outpath 
endif 
else 

go  to  20001 
endif 

go  to  20010 

20009  continue 
Month  -  4 
Day  -  5 
Hour  -  14 
Minute  -  00 
eMonth  —  4 
eDay  -  11 
eHour  -  16 

if  (ijk  .eq.  1)  then 
interval  -  5 
inpath  -  'e:\05min\' 
outpath  -  'c:\w05min\' 
elseif  (ijk  .eq.  2)  then 
interval  -  15 
inpath  -  'e:\15min\' 
outpath  -  ' c :\wl5min\' 
elseif  (ijk  .eq.  3)  then 
interval  -  60 
inpath  -  'e:\lhour\' 
outpath  -  'c;\wlhour\' 
elseif  (ijk  .eq.  4)  then 
interval  -  120 
inpath  -  'e:\2hour\' 
outpath  -  'c:\w2hour\' 
endif 

20010  continue 

^  *******★*******■**-*****************************•**********■**************** 

if  (Single  .eq.  1)  go  to  20102 
open  (3 , file-'Wind. txt' ) 

************************************************************************* 
*  Return  to  here  for  new  file 

(  ****************************************************************************** 

20101  call  inname 
call  outname 

write  (*,*)  'infile  -  infile 
write  (*,*)  'outfile  -  ' .outfile 
write  (3, '(a)')  outfile 
I 

20102  write  (*,90003) 

90003  format 

1  (lx,'  alt  u  v  w  TRP  Ntot  Rate', 

2  '  slope  intercept  PPs(l)  PPs(2)') 

Open  (1 , err-90909 , file-infile , status-' old' , form- 'binary ' ) 

I  20103  Read  (1 , err-90909 , end-90909)  (line(parameter) , parameter-1 , 10) 

if  (line(l)  .gt.  -990)  go  to  20103 
NumSndgs  -  line (2) 
rewind  (1) 

Open  (2 , err-90909 , file-outfile) 

QuitFlag  -  0 

*  c  jzW  -  1 
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do  10101  j  z  =  1,40 

Z(jz)  -  (Al tS tep*f loat ( jz - 1 )  +  AltMin)*le-3 
u( i z)  -  0 


u(jz)  -  0 
v(jz)  -  0 
w(jz)  -  0 
TRP(jz)  -  0 
rmsdvr(jz , 1) 
rmsdvr( j  z , 2 ) 
10101  continue 


do  10102  irej-1,4 
rej (irej)  -  0 
10102  continue 

c  Read  ( 1 , err-90909 , end-20203)  (line(parameter) , parameter-1 , 10) 

************************************************************************** 
*  Return  to  here  for  new  altitude. 

****************************************************************************** 

c 

20201  NumPts  -  0 
rewind  (1) 

Read  (1, err-90909, end-20203)  (line(parameter) .paranieter-l ,  10) 

20202  if  (line(l)  .le.  Z(jzW)-delZ)  then 

Read  (1 , err-90909 , end-20203)  ( line (parameter ), parameter-1 , 10) 

go  to  20202 

endif 

if  (llne(l)  .gt.  Z(jzW)+delZ)  then 

if  ((NumPts  .It.  MinV)  .or.  (NumPts  .It.  MinH))  go  to  20206 
go  to  20204 
endif 
c 

c  Reject  the  point  if:  (1)  altitude  <  1  km. 

c  (2)  zenith  angle  not  between  ThMin  and  ThMax, 

c  (3)  projected  horizontal  velocity  >  vHmax, 

c  (4)  radial  velocity  -  0 

c  (5)  linear  polarization 

c  (6)  ordinary  polarization 

c  (7)  extraordinary  polarization 

c 

TestFlag  -  1 

c  if  ((line(3)  .gt.  0)  .and. 
c  1  (line(4)  .It.  0))  then 
if  (line(l)  .It.  1)  then 
rej(l)  -  rej(l)  +  1 
TestFlag  -  0 
endif 


sinZAx  -  sqrt(sin(line(3)*pi/180)**2 

1  +  sin(line(4)*pi/180)**2) 

if  (  (sinZAx  .It.  sin(ThMin*pi/180) )  .or. 

1  (sinZAx  .gt.  sin(ThMax*p i/180) )  )  then 

rej (2)  -  rej (2)  +  1 
TestFlag  -  0 
endif 

if  (sinZAx  .gt.  0.02  .and.  ipick  .eq.  1)  then 
if (abs(line(2)/sinZAx)  .gt.  vHmax)  then 
rej (3)  -  rej (3)  +  1 
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TestFlag  -  0 

endif 

endif 

if  (line(2)  .eq.  0)  then 
rej(4)  =  rej(4)  +  1 
TestFlag  -  0 
endif 

if  (abs(line(2) )  . gt .  VrMax)  then 

TestFlag  -  0 

endif 


c 

c  Linear  polarization  filter  (removes  linearly  polarized  points): 
c 

if  (polarization  .eq.  'o'  .or.  polarization  .eq.  'x')  then 
if  (abs(line(6) -line(8))  .It.  45)  TestFlag  -  0 
if  (  (abs(line(6)-line(8))  .gt.  135)  .and. 

1  (abs(line(6)-line(8))  .It.  225)  )  TestFlag  -  0 

if  (  (abs(line(6) -line(8) )  .gt.  315)  .and. 

1  (abs(line(6) -line(8))  .It.  360)  )  TestFlag  -  0 

endif 
c 
c 

c  Ordinary  polarization  filter  (removes  ordinary  points); 
c 

if  (polarization  .eq.  '1'  .or.  polarization  .eq.  'x')  then 
if  (line(6) -line(8)  .gt.  45  .and. 

1  lin€(6)-llne(8)  .It.  135  )  TestFlag  -  0 

if  (line(6) -line(8)  .gt.  -315  and. 

1  line(6) -line(8)  .It.  -225  )  TestFlag  -  0 
endif 
c 
c 

c  Extraordinary  polarization  filter  (removes  extraordinary  points); 
c 

if  (polarization  .eq.  '1'  .or.  polarization  .eq.  'o')  then 
if  (line(6) -line(8)  .gt.  -135  .and. 

1  line(6)-line(8)  .It.  -45  )  TestFlag  -  0 

if  (line(6) -line(8)  .gt.  225  .and. 

1  line(6) -line(8)  .It.  315  )  TestFlag  -  0 

endif 
c 
c 
c 

********************************************************************** 
if  (NumPts  .eq.  6500)  then 

write  (*,*)  'Thanks  anyhow,  but  Ive  already  got  6500  points.' 

TestFlag  -  0 

endif 

c  else 

c  TestFlag  -  0 

c  endif 

if  (TestFlag  .eq.  1)  then 
NumPts  —  NumPts  +  1 


do  10201  parameter  -  1,10 
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sppCNumPts . parameter )  =  1 ine ( pararae ce r ) 

10201  continue 

TRP(jzW)  -  TRP(jzW)  +  line(5)**2  +  line(7)**2 
endif 

Read  ( 1 , err-90909 , end-20203)  (line(parameter) , parameter-1 , 10) 
go  to  20202 

20203  quitflag  -  1 

20204  Fitflag  -  1 
c 

c  Fit  the  scattering  points  in  this  window  with  a  3-vector, 
c 

20205  CALL  WFV 

if  (Fitflag  .eq.  0)  then 

write  (*,*)  'Vertical  Failure  at  ',jzW,Z(jzU) 

write  (2,90002)  -1000.0, -1000.0,-1000.0,-1000.0,-1000.0,-1000.0. 

1  - 1000 . 0 . - 1000 . 0 , - 1000 . 0 , - 1000 . 0 , - 1000 . 0 , - 1000 . 0 

go  to  20206 
endif 

Call  WFH 

if  (Fitflag  .eq.  0)  then 

write  (*,*)  'Horizontal  Failure  at  ',jzW,Z(jzW) 

write  (2,90002)  -1000.0.-1000.0.-1000.0.-1000.0,-1000.0,-1000.0, 

1  -1000.0,-1000.0,-1000.0,-1000.0.-1000.0,-1000.0 
else 

if  (TRP(jzW)  .It.  1)  then 

TRP(jzW)  -  0 

else 

TRP(jzW)  -  10*logl0(TRP(jzW)) 
endif 

call  PhFit 

Rate  -  float (NumPts)/NumSndgs 
write  (*.90001) 

1  Z(jzW) .u(jzW) ,v(jzW) .w(jzW) ,TRP(jzW) .NumPts , Rate , 

2  slope, intercept, PPslope(l) ,PPslope(2) 
xl  -  float(NumPts) 

x2  -  float (NPV) 
x3  -  float(NPH) 
write  (2,90002) 

1  Z(jzW) ,u(jzW) ,v(JzW) ,w(jzW) ,w(jzW)*10,TRP(jzW) ,xl,Rate, 

2  slope, intercept, PPslope(l) ,PPslope(2) 
endif 

90001  format  (lx, f4 .0 , 2(lx, f6 . 1) , 2(lx, f 5 . 1) , lx, i4 , 5 (lx, f 5 . 2) ) 

90002  format  (lx, 12(el2 .4, lx)) 
c 

c  If  it's  not  time  to  quit,  increment  jzW  and  go  read  the  next  points, 
c 

20206  if  (QuitFlag  .eq.  0)  then 
jzW  -  jzW  +  1 

if  (jzW  .le.  jzWmax)  then 

c  Read  (1 , err-90909 , end-20203)  (line(parameter) .pararaeter-l , 10) 
go  to  20201 
endif 
endif 


Close  (1) 

Close  (2) 

write  (*,*)  'Rejections;' 

WRITE  (*.*)  '  Z<lkm  ThLimits  vHmax  Vr=0' 

write  (*,*)  (rej (irej ) , irej-1 ,4) 

If  (Single  .eq.  1)  go  to  90909 

if  (month  .eq.  emonth  .and.  day  .eq.  eday  .and. 

1  hour  .eq.  ehour  .and.  minute  .eq.  eminute)  go  to  90909 
BigTime  -  mlnute+hour*60+day*24*60+month*30*24*60  +  interval 
month  =“  BigTime/(30*24*60) 
day  -  (Bigtime-month*30*24*60)/(24*60) 
hour  -  (BigTime'month*30*24*60-Day*24*60)/60 
minute  -  BigTime -month*30*24*60-Day*24*60-Hour*60 
go  to  20101 
90909  close  (1) 
close  (2) 
close  (3) 

91919  if  (loop  .eq.  1)  then 
ijk  -  ijk  +  1 

if  (ijk  .le.  4)  go  to  20009 
endif 

End 
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iriN'^nie  .for 


c 

$Debug 

c 

Subroutine  inName 

c 

c  inName  creates  the  input  file  names  for  WGroup. 

c 

$Include ; 'Wind. inc ' 

$Include : ' Header . inc ' 

c 

c 

character*2  ascmonth , ascday , aschcur , ascminute 

if  (month  .It.  10)  then 

write  (ascmonth , 90001)  '0' .month 

90001  format  (al.il) 
else 

write  (ascmonth, 90002)  month 

90002  format  (i2) 
end  if 

if  (day  .It.  10)  then 

write  (ascday , 90001)  '0' ,day 

else 

write  (ascday, 90002)  day 
endif 

if  (hour  .It.  10)  then 

write  ( as chour , 90001)  '0' .hour 

else 

write  (aschour ,90002)  hour 
endif 

if  (minute  .It.  10)  then 

write  (ascminute , 90001)  '0' .minute 

else 

write  (ascminute , 90002)  minute 
endif 

write  (inf ile , 90003) 

1  inpath , ascMonth , ascDay , ascHour , ascMinute .'.mbs' 

90003  format  (21a) 
return 

end 
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r 


$Dehug 

c 

Subroutine  outName 
c 

c  outName  creates  the  output  file  names  for  WGroup . 
c 

$  Include : 'Wind. inc' 

$  Include : ' Header . inc ' 

c 

c 

chaiacter*2  ascmonth , ascday , aschour , ascminute 

if  (month  .It.  10)  then 

write  (ascmonth , 90001)  'O', month 

90001  format  (al.il) 
else 

write  (ascmonth, 90002)  month 

90002  format  (i2) 
endif 

if  (day  .It.  10)  then 

write  (ascday , 90001)  '0' ,day 

else 

write  (ascday , 90002)  day 
endif 

if  (hour  .It.  10)  then 

write  (aschour , 90001)  'O', hour 

else 

write  (aschour ,90002)  hour 

c>'.d.ki. 

if  (minute  .It.  10)  then 

write  (ascminute , 90001)  'O', minute 

else 

write  (ascminute , 90002)  minute 
endif 

write  (outfile , 90003) 

1  outpath,ascMonth,ascDay,ascHour,ascMinute, ' .maw' 

90003  format  (21a) 
return 

end 
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PliFit  .  f  V- 1 


$Debug 

c 

-k'k'k'k'k'kic'k'krk'kie-k'kie'k'k'k'k'k‘k:ieicic'k'k^'k:k'kic'krkicic'kii:icic'k'k'k':kici:'k'k^:k  -it ^ ^ >r ^ Tt VC  .*■ 

Subroutine  PhFit 

★  ★★★★★★**-:t*******^****Tt**Tfc*  *★****★■**★*■**■*  ■********'^*'^'jt'>t*^t* -it 

c 

C  THIS  SUBROUTINE  fits  two  straight  lines  to  the  'variation  of  velocLt 
c  variance  vs  zenith  angle;  one  line  to  variations  along  the  wind 

c  vector,  the  second  to  variations  perpendicular  tc  the  wind  vector 

C  August  18,  1990 
c 

$ Include : ' Wind . Inc ' 

$Include : ' Header . inc ' 
c 

c  First,  use  all  the  points  to  get  the  intercept, 
c 

sumvr  -  0 
s’jmvrph  -  0 
sumph  —  0 
sumph2  -  0 
sumi  —  0 


do  10101  ialpha  -  1,17 

if  (Numrad( ialpha, 3)  .eq.  0)  go  to  10101 

ZA  -  ialpha  -  0.5 

sumvr  -  sumvr  +  vr ad (ialpha, 3) 

sumvrph  -  sumvrph  +  vrad( ialpha, 3) *ZA 

sumph  -  sumph  +  ZA 

sumph2  -  sumph2  +  ZA**2 

sumI  -  sumI  +  1 

10101  continue 

10102  continue 

if  ((sumi  .ge.  3)  .and. 

1  (suml*sumph2  -  sumph**2  .ne.  0))  then 
slope  -  (suml*sumvrph  -  sumvr*sumph)/(suml*sumph2  -  saraph**2) 
intercept  -  (sumvr  -  slope*sumph)/sumI 
else 

slope  -  0 
intercept  -  0 
PPslope(l)  -  0 
PPslope(2)  -  0 
return 
endif 
c 

c  Now  fit  the  parallel  and  perpendicular  variances  separately, 
c 

do  10202  iDir  -  1,2 
sumvr  -  0 
sumvrph  -  0 
sumph  —  0 
sumph2  —  0 
sumi  —  0 

do  10201  ialpha  -  1,17 

if  (Numrad( ialpha, iDir)  .eq.  0)  go  to  10201 

ZA  -  ialpha  -  0.5 

sumvr  —  sumvr  +  vrad( ialpha, iDir) 
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sumph  *■  sumph  +  ZA 
sujsl  “  sumi  +  1 

10201  continue 
PPslope(iDir)  -  0 

if  (suml  .  gt .  0)  PPslope(  iDlr)“(surnvr- intercept*suinl  )/suniph 

10202  continue 

c  write  (*,*)  ‘NPH,PPCnt(l) ,PPCnt(2) ,PPCnt(3)  -  ' 

c  write  (*,*)  NPH . PPCnt (1) , PPCnt(2) , PPCnt ( 3) 

c  do  10301  ialpha  -  1,17 

c  write  (*,*) 

c  1  ialpha,NumRad( ialpha. l),NumRad(ialpha, 2) ,NuinRad( ialpha, 3) 
10301  continue 
return 
end 


$Debug 

c 

program  SGroup 
c 

c  SGroup  (Scattering-point  Grouping  software)  takes  a  list  of  (presumably 
c  tape-long)  scattering-point  parameter  (mbs)  files  (which  are  specified 
c  in  SGroup.txt),  groups  them  into 

c  time  intervals  specified  by  the  user,  sorts  them  by  altitude,  and 
c  names  them  according  to  the  time  at  the  center  of  the  interval, 
c  Filtering  by  zenith  angle  (ThetaMax;  and  maximum  projected  horizontal 
c  velocity  (Vmax)  are  also  done  here, 
c  Converted  to  10  parameters/point:  3/21/91 
c 

$ Include : ' SGroup . inc ' 

$ inc lude : ' sname . inc ' 
c 

c  Link  Sgroup-HSName-t-SMerge-HBellSub 
c 

***********  SET-UP  AND  INITIALIZE  ************ 
c 

real*4  xnumsndgs 
integer*4  filecount 
character*3  filter 
character*!  answer 
pi  -  3.14159265 
ThetaMax  -  16 
vHmax  -  300 
Zmin  ••  60 
Zmax  -  120 
filter  -  'on' 

write  (*,*)  'SGroup  expects  the  list  of  input  (.mbs)  files  and' 
write  (*,*) 

1' their  polarization  codes  to  be  in  SGroup.txt.' 
path  -  'd:\lhour\' 
write  (*,*)  'Single  file?  (y/n) ' 
read  (*,'(a)')  answer 
if  (answer  .eq.  'y')  then 

write  (*,*)  ' DataSpan, month, day, hour , min  -  ' 
read  (*,*)  DataSpan, month, day, hour, minute 
polarization(l)  -  'o' 
else 

DataSpan  -  60 
Spacing  -  60 
month  -  4 
day  -  5 
hour  -  14 
minute  -  00 
endif 
call  SName 

write  (*,*)  'Ready  to  Fill  First  Output  File  ',sfile 
open  (102,file-sfile,form-'binary' ) 
filecount  -  1 

BigTime  —  Minute  +  Hour*60  -f  Day*24*60  +  Month*30*24*60 

FirstTime  -  BigTime  -  DataSpan/2 

LastTime  -  BigTime  +  DataSpan/2 

open  (101 , file=' SGroup. txt' , status=' old' ) 

iTape  =  1 

20001  read  (101 , 90201 ,end“20002)  infile(iTape) ,polarization(iTape) 

90201  format  (a,2x,a) 


iTape  =  iTape  +  1 
go  to  20001 

20002  close  (101) 

NuniTapes  =  iTape -1 

write  (*,*)  'Number  of  tapes  to  process  =  ' .NumTapes 

do  10001  iSndg  -  1,9 

write  (asciSndg, 90101)  'OOO'.iSndg 

90101  format  (a3,il) 

write  (Sndg( iSndg) , 90005)  ' c :\holda\ asciSndg, mbs ' 

10001  continue 
90005  format  (17a) 

do  10002  iSndg  -  10,99 

write  (asciSndg, 9010'’)  '00', iSndg 

90102  format  (a2,i2) 

write  (Sndg( iSndg) , 90005)  ' c :\holda\' , asciSndg, mbs ' 

10002  continue 

do  10003  iSndg  -  100,500 
write  (asciSndg, 90103)  'O', iSndg 

90103  format  (al,i3) 

write  (Sndg( iSndg) ,90005)  'c;\holda\' , asciSndg, ' .mbs' 

10003  continue 

do  10004  iSndg  -  501,999 
write  (asciSndg, 90103)  'O', iSndg 

write  (Sndg( iSndg) ,90005)  'c:\holdb\' , asciSndg, ' .mbs' 

10004  continue 
iTape  -  1 
Now  -  0 
iSndg  -  0 

******************  NOW  START  PROCESSING  TAPES  **************** 
c 

c  Return  to  here  when  another  input  tape  is  needed, 
c 

20003  write  (*,*)  'Ready  to  Process  Tape  ', infile (iTape) 
write  (*,*)  'Polarization:  ' ,polarization( iTape) 
open  (101 , f ile-infile(iTape) , form-'binary ' ) 

read  (101 , end-20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 
c 

c  Return  to  here  when  another  output  file  is  needed, 
c 

20004  iSndg  -  0 
Now  -  0 

filecount  -  filecount  +  1 
call  SName 

write  (*,*)  'Ready  to  fill  Output  File  ',sfile 
open  (102 , f ile-sf ile , form-'binary' ) 

20005  if  (spp(l)  .It.  -990)  then 
iswitch  -  0 

ThisTime  -  spp( 3)*30*24*60  +  spp(4)*24*60  +  spp(5)*60  +  spp(6) 
if  (ThisTime  .It.  FirstTime)  then 

read  (101 , end-20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 

elseif  (ThisTime  .gt.  LastTime)  then 
go  to  20007 
else 
Now  -  1 
Select  -  0 
endif 
endif 
c 
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Go  back;  not  time  yet. 


if  (Now  .eq.  0)  then 

read  ( 101 , end— 20008 )  (spp(parameter ) , pararaecer-1 , 10) 

go  to  20005 

endif 

if  (filter  .eq.  'off')  go  to  20006 
Filter  by  altitudes. 

if  (spp(l)  .It.  Zmin  .or.  spp(l)  .gt.  Zmax)  then 
read  (101 , end— 20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 
endif 

Polarization  Filters; 
o  -  ordinary 

p  -  ordinary  plus  linear 
X  -  extraordinary 
y  -  extraordinary  plus  linear 
1  -  linear 

c  -  circular  -  ordinary  plus  extraordinary 
n  -  none  (filtering  done  at  20009) . 

linear  polarization  filter 

if  ( (polarization(iTape)  .eq.  'o')  .or. 

1  (polarization(iTape)  .eq.  'x')  .or. 

2  (polarization(iTape)  .eq.  'c'))  then 

pd  -  abs(spp(6) -spp(8} ) 

if  (  (pd  .le.  45)  .or. 

1  (  (pd  .ge.  135)  .and.  (pd  .le.  225)  )  .or. 

2  (pd  .ge.  315)  )  then 

read  (101 , end-20008)  (spp(parameter) , parameter-1 , 10) 

go  to  20005 

endif 

endif 

ordinary  polarization  filter 

if  ( (polarization(iTape)  .eq.  'x')  .or. 

1  (polarizatlon(lTape)  .eq.  'y')  .or. 

2  (polarlzation(iTape)  .eq.  '1'))  then 

if  (spp(6) -spp(8)  .gt.  45  .and.  spp(6) -spp(8)  .It.  135)  then 
read  (101, end-20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 
endif 

if  (spp(6) -spp(8)  .gt.  -315  .and.  spp(6) -spp(8)  .It.  -225)  then 

read  (101, end— 20008)  (spp(parameter) , parameter-1 , 10) 

go  to  20005 

endif 

endif 

extraordinary  polarization  filter: 

if  ( (polarization(iTape)  .eq.  'o')  .or. 

1  (polarization(iTape)  .eq.  'p')  .or. 

2  (polarization(iTape)  .eq.  '1'))  then 
if  (spp(6) -spp(8)  .ge.  -135  .and. 

1  spp(6) -spp(8)  .le.  -45)  then 
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read  ( 101 , end-20008 )  (spp(parameter ) , parameter*! , 10) 

go  to  20005 

endif 

if  (spp(6) -spp(8)  .ge.  225  .and. 

1  spp(6) -spp(8)  .le.  315)  then 
read  (101, end-20008)  (spp(paraineter) , parameter-1 , 10) 
go  to  20005 
endif 
endif 
c 

c  Filter  on  zenith  angle, 
c 

sinZA  -  sqrt(sin(spp(3)*pi/180)**2  +  sin(spp(4)*pi/180)**2) 
if  (asin(sinZA)*180/pi  . gt .  ThetaMax)  then 
read  (101, end-20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 
endif 
c 

c  Filter  on  vHmax. 
c 

if  (sinZA  .gt.  .01)  then 

if  (abs(spp(2)/sinZA)  .gt.  vHmax)  then 

read  (101 , end-20008)  (spp(paraineter) , parameter-1 , 10) 

go  to  20005 

endif 

endif 

20006  if  (iswitch  .eq.  0)  then 
i switch  -  1 

iSndg  -  iSndg  +  1 

if  (iSndg  .gt.  999)  go  to  20008 

close  (103) 

open  (103 , file-Sndg( iSndg) , form-'binary' ) 
endif 

if  (spp(l)  .gt.  -990) 

1  write  (103)  (spp(parameter) , parameter-1 , 10) 
read  (101 , end-20008)  (spp(parameter) , parameter-1 , 10) 
go  to  20005 
c 

c  if  you're  past  the  time  limit,  merge  the  individual  output  files  into 
c  the  outfile,  set  the  new  time  limits,  and  go  do  the  next  output  file, 
c 

20007  close  (103) 

NumSndgs  —  iSndg 

write  (*,*)  'Number  of  Soundings  in  this  group :', NumSndgs 
write  (*,*)  '  ' 

if  (NumSndgs  .gt.  0)  call  SMerge 
xnumsndgs  -  float (numsndgs) 

write  (102)  -999.0,  xnumsndgs,  .0,  .0,  .0,  .0,  .0,  .0,  .0,  .0 
close  (102) 

if  (answer  .eq.  'y')  go  to  90909 
if  (iTape  .eq.  NumTapes+1)  go  to  90909 
BigTime  -  BigTime  +  Spacing 
Month  -  BigTime/ (30*24*60) 

Day  -  (BigTime-Month*30*24*60)/(24*60) 

Hour  -  (BigTime-Month*30*24*60-Day*24*60)/60 
Minute  —  (BigTime-Month*30*24*60-Day*24*60-Hour*60) 

FirstTime  -  BigTime  -  DataSpan/2 
LastTime  -  BigTime  +  DataSpan/2 
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go  to  20004 

20008  close  (101) 

ITape  -  iXape  +  1 

20009  if  (polarization( iXape)  .eq.  'n')  then 
iXape  -  IXape  +  1 

go  to  20009 
endif 

if  (iXape  .le.  NumXapes)  go  to  20003 
if  (iXape  .eq.  NumXapes+1)  go  to  20007 
90909  close  (201) 
call  BellSub 
end 


$Debug 


Subroutine  SName 


c  SName  creates  the  file  names  for  SGroup. 
c 

$  Include : ' Sname . inc' 


if  (month  .It.  10)  then 

write  (ascmonth, 90001)  '0' .month 

90001  format  (al.il) 
else 

write  (ascmonth, 90002)  month 

90002  format  (i2) 
end  if 

if  (day  .It.  10)  then 

write  (ascday , 90001)  'O', day 

else 

write  (ascday ,90002)  day 
endif 

if  (hour  .It.  10)  then 

write  (aschour ,90001)  '0' .hour 

else 

write  (aschour, 90002)  hour 
endif 

if  (minute  .It.  10)  then 

write  (ascminute, 90001)  'O', minute 

else 

write  (ascminute, 90002)  minute 
endif 

write  (sfile , 90003) 

1  path,ascMonth,ascDay,ascHour,ascMinute, ' .mbs' 

90003  format  (28a) 
return 

end 
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SMt^rge  .for 


$Debug 

c 

Subroutine  SMerge 
c 

c  This  subroutine  will  merge  a  number  of  binary  scattering-point 
c  parameter  (.mbs)  files  generated  by  SGroup  into  a  single  file  sorted 
c  by  altitude.  The  names  of  the  files  are  c:\holda\0001.mbs  to  0500. mbs, 
c  and  c:\holdb\0501.mbs  to  0999. mbs. 
c  December  30,  1989. 

c  Modified  for  10-parameter  points:  3/21/91 

c  Looking  for  problem  that  results  in  altitude  order  problem:  5/30/91. 
c 

$ Include ; ' SGroup . inc ' 

dimension  sppl(lO) , spp2(10) 
real*4  zlast 
integer*4  index 

************************************************************************** 

c 

c  read  the  first  file  into  tempi. mbs  to  get  started, 
c 

open  (1 , file-Sndg(l) , status-' old' , form- 'binary' ) 

open  (2 , file-' c : tempi .mbs ' , status- 'unknown' , form- 'binary ' ) 

20001  read  (1, end-20002)  (sppl(parameter) , parameter-1 , 10) 
write  (2)  (sppl(parameter) , parameter-1 , 10) 

go  to  20001 

20002  imark  -  1 
close  (1) 
close  (2) 

if  (NumSndgs  .eq.  2)  go  to  20030 
if  (NumSndgs  .eq.  1)  go  to  20040 

************************************************************************ 
*************************  Process  Files  By  Pairs  ************************** 
c 

c  *********-***  First  File  of  Pair  ************** 

c 

do  10002  ifile  -  2 , NumSndgs - 1 , 2 

open  (1 , file-Sndg( ifile) , status-' old' , form-'binary ' ) 
open  (2,file-'c: tempi. mbs' , status-' old' , form-'binary ' ) 
open  (3,file-'c:temp2.mbs' , status-' unknown' , form-'binary' ) 

40001  read  (1, end-20013)  (sppl(parameter) , parameter-1 , 10) 

40002  read  (2 , end-20012)  (spp2(parameter) , parameter-1 , 10) 

20011  if  (sppl(l)  .It.  spp2(l))  then 

write  (3)  (sppl(parameter) , parameter-1, 10) 

40003  read  (1 , end-20013)  (sppl(parameter) , parameter-1 , 10) 
go  to  20011 

else 

write  (3)  (spp2 (parameter) , parameter-1 , 10) 


40004  read  (2 , end-20012)  (spp2(parameter) , parameter-1, 10) 
go  to  20011 
endif 
c 

c  you  get  here  if  tempi. vbs  ran  out  of  points  before  Sndg. 
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20012  write  (3)  (sppl (parameter) , parameter-1 , 10) 

20112  read  ( 1 , end-20014)  (sppl(parameter) , parameter-1 , 10) 
write  (3)  (sppl(parameter) , parameter-1 , 10) 

go  to  20112 
c 

c  you  get  here  if  Sndg  ran  out  of  points  before  tempi. vbs. 
c 

20013  write  (3)  (spp2 (parameter) , parameter-1 , 10) 

20113  read  (2 , end-20014)  (spp2(parameter) , parameter-1 , 10) 
write  (3)  (spp2(parameter) , parameter-1 , 10) 

go  to  20113 

20014  imark  -  imark  +  1 
close  (1) 

close  (2) 
close  (3) 
c 

c  ★★★★***★***★★  Second  File  of  Pair  ****★'********■* 

c 

open  (1 , file-Sndg(ifile+l) , status-' old' , form- 'binary' ) 
open  (2 , f ile-' c : temp2 .mbs ' , status- 'unknown' , form- 'binary' ) 
open  (3 , file-' c : tempi .mbs' , status-' unknown' , form-' binary ' ) 

40005  read  (1, end-20023)  (sppl(parameter) , parameter-1 , 10) 

40006  read  (2, end-20022)  (spp2(parameter) .parameter-! , 10) 

20021  if  (sppl(l)  .It.  spp2(l))  then 

write  (3)  ( sppl (parameter) , parameter-1 , 10) 

40007  read  (1 , end-20023)  (sppl(parameter) , parameter-1 , 10) 
go  to  20021 

else 

write  (3)  (spp2(parameter) , parameter-1 , 10) 

40008  read  (2 , end-20022)  (spp2(parameter) , parameter-1, 10) 
go  to  20021 

endif 

c 

c  you  get  here  if  tempi. vbs  ran  out  of  points  before  Sndg. 
c 

20022  write  (3)  ( sppl (parameter ), parameter-1, 10) 

20122  read  (1 , end-20024)  (sppl(par£U]ieter)  , parameter-1 , 10) 
write  (3)  ( sppl (parameter) , parameter-1 , 10) 

go  to  20122 
c 

c  you  get  here  if  Sndg  ran  out  of  points  before  tempi. vbs. 
c 

20023  write  (3)  (spp2(parameter) , parameter-1, 10) 

20123  read  (2 , end-20024)  (spp2 (parameter) , parameter-1 , 10) 
write  (3)  (spp2(parameter) , parameter-1 , 10) 


go  to  20123 


20024  imark  *  imark  +  1 
close  (1) 
close  (2) 
close  (3) 

10002  continue 

if  (NumSndgs - imark  .eq.  1)  go  to  20030 
if  (NumSndgs- imark  .eq.  0)  go  to  20040 

****-k******-k*-k**********-k**icitit**-k*****-k***ie***************-k-k***-ic*-k*-k-kific-k 

C 

c  if  the  number  of  files  is  even,  there  will  still  be  one  file  left. 


20030  open  (1 , file— Sndg(NumSndgs) , status-' old' , form— ' binary ' ) 
open  (2 , f ile-' c ; tempi .mbs' , status-' old' , form- 'binary' ) 

40009  read  (1 , end-20033)  (sppl(parameter) , parameter-1 , 10) 

40010  read  (2 , end-20032)  (spp2(parameter) , parameter-1 , 10) 

20031  if  (sppl(l)  .It.  spp2(l))  then 

write  (102)  (sppl(parameter) , parameter-1 , 10) 

40011  read  (1 , end-20033)  (sppl(parameter) , parameter-1 , 10) 
go  to  20031 

else 

write  (102)  (spp2 (parameter) , parameter-1 , 10) 

40012  read  (2, end-20032)  (spp2(parameter) , parameter-1 , 10) 
go  to  20031 

endif 

c 

c  you  get  here  if  tempi. vbs  ran  out  of  points  before  Sndg. 
c 

20032  write  (102)  (sppl(parameter) , parameter-1 , 10) 

20132  read  (1, end-30001)  (sppl(parameter) , parameter-1 , 10) 
write  (102)  (sppl(parameter) , parameter-1 , 10) 

go  to  20132 
c 

c  you  get  here  if  Sndg  ran  out  of  points  before  tempi. vbs. 
c 

20033  write  (102)  (spp2(parameter) , parameter-1, 10) 

20133  read  (2, end-30001)  (spp2(parameter) , parameter-1 , 10) 
write  (102)  (spp2 (parameter) , parameter-1 , 10) 

go  to  20133 

****************Tlr'*r********'»HI:**'Jh****illr>Wr********************************** 

C 

c  If  the  number  of  files  was  odd,  or  there  was  only  one  file 
c  initially,  transfer  the  sorted  file  into  mergeout . vbs . 
c 

20040  open  (1 , file-'c : tempi . mbs' , status-' old' , form-'binary' ) 

20041  read  (1 , end-30001)  (sppl(parameter) , parameter-1 , 10) 
write  (102)  (sppl(parameter) , parameter-1 , 10) 


go  to  20041 


30001  close  (1) 
close  (2) 
close  (3) 
end 
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subroutine  Bellsub 
integer*2  ihr , Imin, isec , ilOOth 
integer*4  duration 
real*4  LastTime .ThisTime 
character*!  ding 

Call  gettini(  ihr ,  imin,  isec  ,  ilOOth) 

Duration  -  0 

LastTime  -  ihr*3600  +  imin*60  +  isec  +  ilOOth*. 01 
ding  -  char (7) 

20001  write  (*,90001)  ding 
90001  format  (al,\) 

20002  Call  gettim( ihr , imin, isec , ilOOth) 

ThisTime  —  ihr*3600  +  imin*60  +  isec  +  ilOOth*. 01 

if  (ThisTime  -  LastTime  .It.  1)  go  to  20002 

Last  Time  -  ThisTime 

Duration  -  Duration  +  1 

if  (Duration  .le.  10)  go  to  20001 

return 

end 


sname , inc 


c  sname . inc 

common  /snamel/  month.day .hour .minute , sfile .path 
character*2  ascmonth , ascday , aschour . ascminute 
integer*^  month.day .hour .minute 
characCer*9  path 
character*40  sfile 


SGroup . inc 


c 

c 

c  SGroup . inc 
c 

common  /SGl/  BigTime .pi.ThetaMax, Vmax.NumSndgs , Sndg 
c  common  /SG2/  SuniNum(44)  ,SumPwr(44) 

dimension  spp(lO) , infile(lOOO) ,Sndg(1000) .polarizationClOOO) 
real*8  SumNum ,  StunPwr 
real*4  spp.ThetaMax.Vmax.pi 

integer*4  iTape, group, NoiseLimit.NoiseCount, iSndg, 

1  BigTime .FirstTime .Last! ime , DataSpan, Spacing, 

2  NumSndgs, parameter, select, Now 
character*4  ascisndg 

character*16  infile 
character*! 7  Sndg 
character*!  polarization 
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DatLog.txt 


Dat  #01 

GR233;  50  raw  files;  list,  49  processed  files,  .mbs  file.  lOi  lOl 

GR235:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  202 

GR236:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  303 

GR239:  49  raw  files;  list,  47  processed  files,  .mbs  file.  98  401 

GR240:  49  raw  files;  list,  47  processed  files,  .mbs  file.  98  499 

GR241:  48  raw  files;  list,  45  processed  files,  .mbs  file.  95  594 

GR242:  50  raw  files;  list,  49  processed  files,  .mbs  file.  lOi  695 

GR243:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  796 

GR244:  49  raw  files;  list,  47  processed  files,  .mbs  file.  98  894 

GR245:  50  raw  files;  list,  49  processed  files,  ....bs  file.  101  995 

Dat  #02 

GR246;  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  101 

GR247:  46  raw  files;  list,  43  processed  files,  .mbs  file.  91  192 

GR248:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  293 

GR249:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  394 

GR250:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  495 

GR251:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  596 

GR252;  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  697 

GR253;  49  raw  files;  list,  45  processed  files,  .mbs  file.  96  793 

GR254:  50  raw  files;  list,  49  processed  files,  .mbs  file.  101  894 

GR255;  49  raw  files,  list,  31  processed  files,  .mbs  file.  82  976 

Dat  #03  (Djuth) 

GR267:  40  raw  files,  list,  38  processed  files,  .mbs  file.  80  80 

GR268;  41  raw  files,  list,  38  processed  files,  .mbs  file.  80  160 

GR292:  41  raw  files,  list,  39  processed  files,  .mbs  file.  82  242 

GR293:  40  raw  files,  list,  38  processed  files,  .mbs  file.  80  322 

GR334;  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  421 

GR335;  49  raw  files,  list,  47  processed  files,  .mbs  file.  98  519 

GR336:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  618 

Dat  #04 

GR160:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  99 

GR161:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  198 

GR162:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  297 

GR163;  48  raw  files,  list,  47  processed  files,  .mbs  file.  97  394 

GR164:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  493 

GR165:  48  raw  files,  list,  46  processed  files,  .mbs  file.  96  589 

GR166:  47  raw  files,  list,  44  processed  files,  .mbs  file.  93  682 

GR167:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  781 

GR168:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  880 

GR169:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  979 

Dat  #05 

GR170:  49  raw  files,  list,  48  processed  files,  .mbs  file.  99  99 

GR171:  raw  files,  list,  processed  files,  .mbs  file. 

GR172:  raw  files,  list,  processed  files,  .mbs  file. 

GR173:  raw  files,  list,  processed  files,  .mbs  file. 


The  DAT  to  disc  copying  program  TAPEREAD.f 


This,  and  the  follov;ing  Macintosh  II  compatible  FORTRAN 
17  programs  have  been  developed  by  Bob  Roper  to  tacilitaoe 
the  comparisons  of  IDI  -  ISR  and  lOI  -  Fabry-Ferco 
spectrom,eter  (FPS)  winds,  with  appropr iaceiy  acknowledged 
portions  of  the  Adams'  programs  used  to  obviate  reinvenoicn. 

TAPEREAD.f  copies  the  scattering  point  paramecer  files 
from  DAT  to  hard  drive  as  SPP  -  GR  XXX  files  (where  XKX  is 
the  original  MAPSTAR  9  track  data  tape  number)  for  subsequent 
processing  by  programs  IDIXIND.f,  GROVES . f  and  ISRIDI IDIG . f  . 
This  may  seem  redundant,  but  the  original  scattering  pcino 
parameter  files  contain  Universal  Coordinated  Time  (UTC)  data 
from  close  to  the  surface  to  as  high  as  1 3  0km .  TAPEREAD 
changes  the  timing  to  local  mean  solar  time  (LMST  =  UTC  -  4 
hours  28  minutes  for  Arecibo,  which  is  at  18°N,  67°w.  The 
change  to  LMST  conforms  to  the  international  protocol  for  the 
reporting  of  atmospheric  tidal  wind  phases)  and  records  only 
those  scattering  points  whose  altitudes  are  between  66  and 
116km,  which  spans  the  altitude  range  (70  -  95Km)  of  primary 
interest  in  the  AIDA  comparisons;  the  altitudes  from  66  to 
116km  are  used  in  the  IDI  wind  and  GROVES  analyses.  A 
considerable  amount  of  time  in  subsequent  processing  is  saved 
because  of  not  only  the  smaller  data  set,  but  also  the 
decreased  data  access  time.. 

TAPEREAD  uses  a  subroutine  IQTAPE,  which  is  a  proprietary 
item.  The  WangDAT  tape  drive  accessing  IQTAPE  routines  may  be 
purchased  from 


Cyber-Comp  Inc., 

10522  Topeka  Drive, 
Northridge,  CA  91326-3032 


Phone  (818)  366-6786 


PROGP-A.M  TAPPRSAD 
READS  War.aDAT  TAFE,  W?,: 


i  'i  t-  ^  ^  n  r  E  R  Kr^  v‘< 


AND  PRINT: 


RAW  DATA  TAPE) 
TI3TICS  TO  rCRSEN. 


REJECTS  ALE  DATA  OUTSIDE  HEIGHT 


ZMIN  TO  ZMAE, 


AND  ALL  AES  I  ARRIVAL  AZIGLES )  >  ?C  DEGREES. 

COirZERTS  TIMES  TO  LOCAL  MEAN  SOLAR  ,ARECIEO;  ISN,S“W' 

REQUIRES  SUB.ROUTINES 

RDYWANG 

3WITCH7  (  IBM  TO  M„AC  REALS  i 

I  BAD 

IQTAPE 

REAL*4  SFBLOCK(IO)  .SPBYTEdO)  ,  FLAG 
INTEGER*!  STATS (64) 

INTEGER*4  CHAN, IFIX,NUM, ISIZE, NBOUT,  SKI? 

CHARACTER*!  DUM ( 40 ), BITE ( 16384 ) 

CHARACTER*40  DUMMY 
COMMON  STATS, BITE 
EQUIVALENCE  (DUMMY, DUM) 

LAST=341 

ZMAX=116.0 

ZMIN=66 . 0 

FLAG=-999 . 0 

NOUGHT =0 

ZERO=0.0 

NBAD=NOUGHT 

NINETY=90 . 0 

CHAN =3 

IFIX=NOUGHT 

NUM=1 

SIZE=!6384 

NBOUT=16384 

HOLD=ZERO 

WRITE  (*,*)  "  PROGRAM  TAPECOPY  -  WangDAT  TO  DISC" 

WRITE  (*,*)  "  " 

WRITE  (*,*)  "  ENTER  FIRST  SPP  TAPE  NUMBER  THIS  DAT  TAPE' 

READ  ( *  ,  *  )  ITAPE 

WRITE  (*,*)  "  ENTER  START  TAPE  NTJMBER" 

READ  (  * , *  )  NTAPE 

WRITE  (*,*)  "  ENTER  LAST  TAPE  NUMBER" 

READ  (  *  ,  *  )  LAST 
SKIP=NTAPE- ITAPE 
CALL  RDTWANG  (SKIP) 

OPEN  (17, FILE="DIAGNOS" , FORM= ” FORMATTED “ ) 

6  LOOP=NOUGHT 
NGOOD=NOUGHT 

WRITE  (*,*)  "  PROCESSING  TAPE  ".NTAPE 

WRITE  (17,*)  "  PROCESSING  TAPE  ", NTAPE 


DEFINE  SCRATCH  TAPE 
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nno  n  n  n  n  n  n 


OPEN  (16,  f:lh:="temf“,foem^' 


=  ''  1  F  : 

-  •  ,-1  "  ^  ; 
(i:^ (mtaf; 

;:=MTAFE- : 


!  *  ’  0  ■■  1  ,  '  '  0 


Dl'M  (11;  =CHAR  i  -  3  } 

"UM  (  12  )  =CHAP.  (11-^451 

OPEN  (26,  FILE^DL'NIMY,  FORM= '''li.'FORMATTED"  i 

jerr=:qtape  ( is, chan, :f:x, num, bite, e:ze,nsoct, 

IF  (JERR.EQ.3)  GO  TO  20 
IF  (JERR.GT.-l)  GO  TO  15 
IF  (JERR.EQ.-l)  GO  TO  16 

WRITE  (*,*)  +  +  +  -  TAPE  READ  ERROR  +  JERR 

GO  TO  7 

WRITE  TEMPORARY  FILE 

WRITE (16)  BITE 
GO  TO  7 

SELECT  USEFUL  DATA  FROM  FILE  “TEMP" 

REWIND  (16) 

READ  (16,END=33)  SPBYTE 
CALL  SWITCHV  ( SFBLOCK, SPBYTE) 

IF  (SPBLOCK(l) .EQ.FLAG)  GO  TO  310 

ACCEPT  ONLY  ECHOES  BETWEEN  ZMIN  AND  2MA2< 

IF  (SPBLOCK(l) .LT.ZMIN)  GO  TO  30 
IF  (SPBLOCKd)  .GT.ZMAX)  GO  TO  30 

REJECT  ANGLES  GREATER  THAN  90  DEGREES 

IF  (ABS (SPBLOCK (3 )) .GT. NINETY)  GO  TO  31 
IF  (ABS (SPBLOCK (4 )) .GT. NINETY)  GOTO  31 
GO  TO  32 

NBAD=NBAD+1 
GO  TO  30 

MY=SPBLOCK(2 ) 

MO=SPBLOCK(3) 

JO=S?BLOCK(4) 

LTIMH=SPBLOCK (5) 

LTIMM=SPBLOCK(6) 

MSEC=SPELOCK (7 ) 

CHANGE  UT  TO  LOCAL  MEAN  SOLAR  {UT-4H  28M) 


LTIMM=LTIMM-28 
IF(LTIMM.GE.O)  GO  TO  130 


, JERR, HOLD 
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nn  n  n  n  H  non 


in  MM  =  IT  IMM  -  'f  ■- 
LTIMH  =  T'TIMH-  1 

130  Lr:MH=LTIMH-4  • 

:Fi LTIMH.GE. C i  GO  TO  155 
ltimh=lt:mh-24 
JO=JO-l 

l'?5  3PBLOCK  !  4  )  =JO 

3PBLOCK  V  5 i =Lr:MH 

3PELOCK  (  6  ;  =LT:124  ^ 

3PBLOCK (7 ) =MSEC 
C 

C  THIS  IS  A  USEABLE  POINT  1 

C  WRITE  SPBLOCK  TO  DISC 

C 

32  WRITE  (26)  SPBLOCK 

IF(SP3L0CK(1) .EQ.FLAG)  GO  TO  320  # 

MGOOD=NGOOD+l 
GO  TO  30 
320  LOOP=LOOP+l 

IF (LOOP. NE. 1)  GO  TO  30 
WRITE  (*,*)  SPBLOCK 

WRITE  (17,*)  SPBLOCK  ^ 

GO  TO  30  * 

CLOSE  DISC  FILE  OF  CURRENT  NTAPE 


33  WRITE  (*,100)  NBAD,NG(X)D 
100  FORMAT  (/'■  NUMBER  OF  BAD  RECORDS  THIS  TAPE  =",16/ 

*"  NUMBER  OF  USEABLE  RECORDS  THIS  TAPE  =",16/) 

WRITE  (17,100)  NBAD,NGOOD 

WRITE  (*,*)"  *****  £oF  *****  EOF  ***** 

WRITE  (17,*)  "  *****  EOF  *****  EOF  ***** 

WRITE  ( *  ,  * )  "  " 

WRITE  ( 17 , * )  "  " 

NBAD=NOUGHT 
CLOSE  (26) 

CLOSE  (16,STATUS="DELETE") 

3  4  NTAPE=NTAPE-i-l 

IF  ( NTAPE. GT. LAST)  GO  TO  20 
CALL  IBAD  (NTAPE, SKIP) 

IF  (SKIP.EQ.l)  JERR=IQTAPE  ( 7 , CHAN, IFIX, SKIP , 

*BITE, SIZE,NBOUT, STATS) 

IF  (SKIP.EQ.l)  WRITE  (*,*)  "  SKIPPING  FILE  SPP  -  GR" 

IF  (SKIP.EQ.l)  WRITE  (17,*)  “  SKIPPING  FILE  SPP  -  GR 

IF(JERR.EQ.8)  GO  TO  20 
PE  MARKER 

IF  (SKIP.EQ.l)  GO  TO  34 
GO  TO  6 


lOF 


EOF  *»*»*" 


,  NTA 
" , NTAPE 

: END  OF 


PROCESSING  COMPLETE 


20  CLOSE  (17) 

PAUSE  "  ALL  DONE" 

STOP 

END  • 

SUBROUTINE  RDYWANG  (SKIP) 

DECEMBER  13,  1991 
SCATTERING  POINT  PARAjMETERS  -  WangDAT  TAPE  SETUP 
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0)  cu 


1  r. 0 r  *  -  r  (  _  '  ,  s  c ciU  s  (  c-  4  j 

:':tsge?.'4  cha:;,  g:ze,  skip,  sk:?:t,  try,  tapeoge 

C  All  INTEGERS  MUST  EE  LONGWCRD  i:NTEGER»4. 

COMMON  STATS.EUF 

WRITE  [*.*!  ••  REATYING  WangOAT  TAPE  ORII'E" 

WRITE  I  *  ,  *  1  ”  " 

CHAN =3 
I F IX=  0 
ijKxPIT^O 
NUM=1 

SIZE=1d384 

NBOUT=l 

NFILE=0 

TRY=0 

C 

WRITE  ;*,*)  "  " 

1  WRITE  (*,*)  "  TAPE  DRIVE  POSITIONING  -  PLEASE  WAIT. 

1  err=iqtape ( 0 , chan ,ifix,3kipic,buf,size, nbout , sea 

READY? 

TRY=TRY+1 

IF{TRY.GT.2)  GO  TO  2 
IF(JERR.NE. 0)  GO  TO  1 

jerr=iqtape  ( 5 ,  chan,  if  ix,  skipic  ,  buf ,  size,  .nbout ,  sta 

the  tape 

IF(JERR.ME.O)  GO  TO  2 

jerr=iqtape ( 7 , chan, if ix, SKIP, buf , size, nbout , stats ) 

files 

RETURN 

2  WRITE  (*,104)  JERR 

104  format  ( "  ERROR  ",I3,“  CHECK  WANGDAT  DRIVE") 

WRITE  (25,104)  JERR 
PAUSE  "  HIT  RETURN  TO  EXIT" 

STOP 

END 

SUBROUTINE  SWITCH?  (BLOCK, BYTE) 

C  MAY  15,  1991 

C  SWITCHES  TO  AND  FROM  IBM/MAC  FLOATING  POINT  NUMBERS 


CHARACTER*!  A(4),I(4) 
REAL  BLOCK ( 10 ) , BYTE ( 10 ) 
EQUIVALENCE  (R,A) 

DO  1  J=l, 10 
R=BYTE ( J) 

I  (1)  =A(4) 

I  (2)  =A(3) 

I  (3) =A(2) 

I  (4)  =A(1) 

A(l) =I (1) 

A(2) =I (2) 

A(3)=^(3) 

A(4)=. (4) 

BLOCK{J) =R 

CONTINUE 

RETUPJI 


:bad 


c 

c 

c 


1. 

c 


iND 

3'L’B?.CL'TI^iE 


(  ;? HE,  BKIF 


THIS  ROUTINE  FOR  AIDA' 

Ar;D  MAY  2  -  S  -UO  BAD 

IMTEGER'4  3ADFILES(3), 

DATA  3ADFILES '163, 213, 

SKIP=0 
DO  1  1=1,3 
IFdFILE.EQ.BADFILESd)  )  GOTO 
CONTINUE 
RETURN 
SKIP=1 
RETURN 
END 
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a")  u.  CO 


The  tidal  wind  analysis  program  GROVES.f 


The  rORTRP'T^  '’7  program  GROVES  calcuiaoes  one  zonal,  r.eriiicnal  and 
vertical  com.por.enc3  of  the  .mean  (prevailing)  wind  and  periodic 
components  !  un  to  4  harm.onics,  inclndi.ng  t.he  funda.me.ntal :rtz'.  one 
scattering  point  parameter  files  SPP  -  GR  XXX  on  disc.  The  .seal 
configuration  (see  input  file  7GRODAT  belov/)  selects  the  diurnal  -llnr' 
a.nd  semidiurnal  (12hr)  tidal  components,  but  arc/  iundamenta-  period 
(less  tnan  the  data  i.nterval,  of  course;)  may  be  specified. 

Requires  Che  following  input  files  in  the  sa.me  folder 


C.ADDSREC,  which  specifies  the  designator  for  t.he  output  files. 
Specification  is  year,  month,  startday  of  i.nterval  to  be  anaiysed. 

890503 

xxxxxx 


7DUNK,  which  contains  t.he  header  for  each  page  of  the  output  file 
%  XXXXXXGROOUT . 

RESULTS  FOR  APRIL  5  -  APRIL  11  1989  MAPSTAR 

AIDA  '89 

OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOCOOOOCGOOOCOOCOOQCOOOOOCOOOCCOOOO 

00000000 

®  7DATES,  which  contains  dace  and  location  information. 


000000000000000000000000000000000000000000000000000 
APL  5  APL  11  1989 

ARECIBO  (18N,67W) 

OOOOXXXOXXOOOXXXOXXOOXXXXOOOOOOXOOOOOOOOOOOOOOOOOOO 

7GRODAT,  which  determines  the  processing  parameters  as  follows 


890405 . 

89041 

0 

5.  10. 

• 

0 

2  2  2 
66. 116. 

24  . 

5  5  5 

5  5 

5  5  5 

5  5 

3  3  3 

3  3 

• 

0 

QUADRANTS) 

INCLUSIVE  DATES 
START  HOUR 

ZENITH  ANGLES  ACCEPTED 
RANGE  CORRECTION 

NO.  OF  HARMONICS  (INCLUDING  FUNDAMENTAL) 

HEIGHT  RANGE 

FUNDAMENTAL  PERIOD 

POLYNOMIAL  FIT  COEFFICIENTS  NA 

NB 

NO 

PROCESS  AZIMUTH  QUADRANTS  1-4  (0  FOR  ALL 


The  subroutines  used  are  listed  as  include  files  in  t.he  main 
program.  The  purpose  of  each  is  detailed  as  comments  in  eac.h  progra.m. 


The  output  files  ,  with  prefixes  as  in  CADDSPEC  above,  are 
ECHORATE,  a  height /time  table  of  scattering  point  rate 


GLDFRNT, 


a  report  format  table  of  wind  components 
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ARC  H  ;  T  ,  a  b  i  na  r'_/ 


GROOCT,  ccn'ains  all  inforrr^a'icn  acprcpria'ie  ic  pr.^ess; 
including  a  liscing  or  all  3??  -  GR  XXX  files  read,  an  ecr.o 
rabies  of  zonal,  rr.er idional  and  verrical  '.vind  ccn.por.enr 3 

TICE,  a  binary  file  ccnraining  one  ridal  anplirudes  and 

ERROR,  a  binary  wirh  rhe  ridal  anplirude  and  phase  error 

ATIDE,  an  ASCII  version  of  TIDE. 
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OOOOOO . OOOGCCOQO . XOCOOOGCCOGOCOCOCOCGOCC 
OOGG 

C  PROGRAM  GF.OSTAR 


:OOCCGGCC 


GROVES  A:iALYSIi 


-  MACINTOSH  II  MFW 
WITH  I NCI 


AFPLIES  ST.ANDARD  GROVES  METEOR  WIND  ANALYSIS  TO  MAFSTAR  RAJ 
SCATTERING  POINT  PARA-METER  DATA  AS  SF?  -  GR  XXX  FILES 
WRITTEN  ON  DISC  BY  PROGRAM!  TAFEPEAD. 

A  RUN  CONSISTS  OF 
MAIN  PROGRAM  GROSTAR.apl 
WHICH  CONTAINS  AS  APPENDED  FILES 
SUBROUTINE  MAPARAxM 
SUBROUTINE  MAPSTAR 
SUBROUTINE  MATS IN 
SUBROUTINE  GMONTH 
SUBROUTINE  DAEMON 
SUBROUTINE  SDI.ANA 
SUBROUTINE  SVARY 
SUBROUTINE  SDESIG 
SUBROUTINE  ECHO 
SUBROUTINE  GROWZ 
SUBROUTINE  GWINGZ 
SUBROUTINE  GPRINT7 
SUBROUTINE  TRANS7 
SUBROUTINE  IBAD.f 
SUBROUTINE  DateTime 

FILES  XXXXARCHIT,  XXXXECHORATE,  XXXXERRO'’  AND  XXXXTIDE 
(FOR  INPUT  TO  ARCHIVE),  XXXXATIDE  (FOR  INPUT  TO  ARCH. ETC) 
XXXXZONAL  AND  XXXXMERIDIONAL  (FOR  INPUT  TO  "WINGZ"), 

AND  XXXXGLDPRNT  (REPORT  FORMAT  WIND  COMPONENT  LISTING) 

ARE  CREATED  BY  GROVES. 

XXXX  DENOTES  THE  FILE  SDESIGNATOR  FOR  ANY  GIVEN  RUN,  INPUT 
AT  RUNTIME  FROM  AUTOMATICALLY  UPDATED  HDI3C  FILE  CADDSPEC. 


READS  RESULT  SOURCE  FROM  FILE  7DUNK  (INPUT  FILE,  HDISC)  FOR.MA 


72A1, 8A1 


READS  INPUT  DATA  FROM  7GRODAT  (INPUT  FILE,  HDISC) 
IN  THE  FOLLOWING  ORDER 

DATA  INTERVAL  TO  BE  PROCESSED,  FORMAT  I6,3X,I5 
STRTDA  =  START  DAY,  6  DIGITS  -  YEAR  MONTH  DAY. 


ENDDAY  =  END  DAY, 


6  DIGITS  -  YEAR  MONTH  DAY. 


29,1970. 


IF  STRTDA-ENDDAY  IS  BLANK,  ALL  D.ATA  IN  FILE  WILL  BE  PROCESS: 

START  HOUR,  FORMAT  16 

IF  START  HOUR  >  0,  ONLY  24  HOURS  OF  DATA  WILL  EE  PROCESSED. 
ZENITH  ANGLES  ACCEPTED,  FORMAT  2E6.0 

RANGE  CORRECTION,  FORMAT  F6 . 0 

EAST-WEST  TIME  VARIATION  NP,  NORTH-SOUTH  TIME  VARIATION  NQ, 
AND  VERTICAL  TIME  VARIATION  NR,  FORMAT  313 
PERIODICITY  OF  FUNDAMENTAL  TIME  V.ARIATICN  FORMAT  F 7  .  j 
HEIGHT  RANGE  ZMIN,  ZMAX .  FORMAT  15,14 
EAST-WEST  HEIGHT  PROFILE.  FORMAT  2413 
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C  ^;0P.TH-30■:TH  HEIGHT  PROFILE.  FORMAT  34:3 

C  ’/ERTICAL  HEIGHT  PROFILE.  FORMAT  2413 

C  WIMTE  ARE  COLcILEREO  HGRI3CMAL  IF  '.'EFTIGAL  HEIGHT  FrCFILE  IF 

C  GLESIGNATEL  MEGATIVE  • 

C  QG.ATR.ANTS  TO  BE  P.ROCES3ED  -  ZERO  FOR  ALL  QL’ADR.iGiTG  .  FORMAT  13 

C  SUER.OL'TI.ME  GPF.IN'T?  RE.AOG  DATA  INTERVAL  FROM  7T.ATEG  i  IMFGT  FILE, 

HDI3C' 


c 

c 

c 

c 

c 

c 

.MOMTH,  DAY,  -  .MONTH,  DAY,  YMAR,  .-OR.M.AT  3 .K ,  A4  ,  '  M  'X ,  A4  ,  '  ■  ,  I 

REQGIREE  SCATTERING  POINT  PARAMETER  DATA  Oi;  WANGDAT  RARE  AO 

f:le  ;s,'  "dummy"  which  is  (.are)  specified  at  runtime. 

D.ATA  .MUST  3E  IN  SP?  OUTPUT  T.APE  FORMAT  -  10  REALS  PE?  ?  ECS  FT 

IN  IBM  PC  REAL  FORMAT,  COMPLETE  WITH  TIMING  FR.AMES . 

• 

GLOBAL  DEFINE 

INCLUDE  "Types,  ir.c" 

INCLUDE  "OSUtils  .  i.-c" 

END 

• 

c 

DIMENSION  Q(200 , 200)  , P(200) , AC (2  0Q) ,NA( 10 ) ,NB( 10 )  , NC  < 1 ; )  , 

1D{200)  ,SIGMA(200)  ,SINJ(10)  ,COSJ(10)  ,NTIMEi24)  ,A(20:.,200) 

CHARACTER*!  NGO, NPRINT , RESULT ( 72 ) ,SOURCE(8) , FF 

CHARACTER*!  CADD ( 6 ) 

CHARACTER*40  ECHORATE , DUMMY , INSTART, INEND , TFILE , T4 

INTEGER* 1  ICADD { 6 ) , ZERO 

INTEGER* 2  STRTHR 

INTEGER*4  M, IDATE(3) , ISEC, ISECl, ISEC2, :SEC3 

COMMON  /  WINDS  /  N ,  Q ,  NOP  ,  ZMIN ,  MIN ,  ZMJAX ,  MAX ,  NA ,  NB ,  NC ,  NAO ,  NEO , 

• 

*NCO, SUM, AC,NTIME,NP,NQ,NR, RESULT, SOURCE, PERIOD, 

*FF,CADD,Z,A 

COMMON/ECHOES/  P, VEL, SINJ, COSJ, DCL, DCM, DCN, SUM! , 3UM2 , SUM3 , 

*D, SIGMA, AZENMIN,AZENMAX, lEND 

COMMON/ EXTRAS /  lUNIT , ICADD , NGO , 3TRTDA , ENDDAY , LEAPYR , JMO , 

*  MNO {20,24),NFILE, LENGTH , NEG , NPMAX , ZERO , NFR INT , DAY , JOBAD 

• 

COMMON /GENE/  M,UR,MY,MO,JO,LTIMH,LTIMM,MSEC,EL3,EM3 

COMMON/FSPEC/IFILE, DUMMY, INSTART, INEND, NSTART, NPOINTS 

COMMON /HRSTRT/  STRTHR , RNGCOR, ISECl, ISEC2 , ISEC3 

COMMON /HEIGHTS/ NOZ , NQUAD 

COMMON/TEMPO/ IDATE, LHOUR, LMIN,  LSEC 

• 

c 

CALL  DateTime 

ISEC1=3600*LHOUR+60*LMIN+LSEC 

c 

• 

c 

c 

SET  UP  PROCESSING  PARAMETERS 

NBOMB=l 

c 

c 

CALL  MAPARAM 

READ  DATA,  ECHO  BY  ECHO. 

c 

• 

M=0 

UR=0 . 0 

JO BAD =0 

3 

CALL  MAPSTAR 

IF  (UR.LT. 0 . 9)  GO  TO  100 

c 

• 

c 

NEXT  COMES  PROCESSING  OF  ECHO  DATA  TO  PRODUCE  COLUMNS  D  .AND  ?, 

c 

AND  MATRIX  Q. 

• 
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o  n  o  n  n  n  n  n  n 


c 


DC1=EL3 
2'CM=  EM  3 


.:ha::ge  eieectio?:  cosimes  and  veiG'Citv  ;e  wind  id  t 

HORIZONTAL 

IF iNEG .NE. -1 '  GO  TO  333 
D:NKI=3QRT ( 1 . C-DCN**2 ) 

DCL=DCL/SINKI 
DCM=DCM  sink: 

DCN=U . 0 

VEL  =  '/EL;'SINKI 


333  CONTINUE 
CALL  ECHO 
GO  TO  3 

PRELIMINARY  OUTPUT. 


100  NBOMB=2 

CLOSE  (lUNIT) 

IF  (NQUAD.NE.O)  GO  TO  198 
WRITE  (26,197) 

197  FORMAT  (/"  ALL  QUADR.ANTS  PROCESSED”/) 

GO  TO  150 

198  WRITE  (26,199)  NQUAD 

199  FORMAT  (/”  QUADRANT" ,  12  ,  "  PROCESSED",,') 

150  ENDDAY=DAY 

WRITE (2 6, 200)  STRTDA, ENDDAY 
2CC  FORMAT(/15H  DATA  INTERVAL,  3X,  F7 . 0 , 4H  TO,F3.G/.' 

IIX, "  VARIATION  OF  UPPER  ATMOSPHERE  WINDS  WITH  HEIGHT”,/ 

2 /IX,"  GROVES  ANALYSIS,  WITH  ERROR  DETERMINATION"//) 

WRITE (26, 201)  CADD 

201  FORMJ)lT(1X,  "  OUTPUT  FILES  FROM  THIS  RUN  HAVE  PREFIX  "  ,  4A1 ) 
WRITE (26,202)  M , NSTART , NPOINTS , AZENMIN, AZENMAX , N , INSTART , 

♦ INEND , STRTHR , NP , NQ , NR , MAX , MIN , NAO , NA , NBO , NB , NCO , NC , PER lOD 
202  FORMAT (IX// IX, "  NUMBER  OF  SCATTERING  POINTS  PROCESSED 

118/"  (STARTING  FROM  ",I5,"  AND  PROCESSING  ",I5,”  ?OINT(S) 
2",/"  FOR  EACH  1  KM  HEIGHT  INTERVAL  OF  EACH  RADAR  FRAME", 

3/"  WITH  ZENITH  ANGLES  BETWEEN” , F4 . 0 , "AND" , F4 . 0 , "  DEGREES)"/ 
4 /IX,"  NUMBER  OF  INPUT  PARAMETERS  = " , 14 , / / / IX , "  DATA  READ 
5  FROM  TAPE  FILES  STARTFILE  ",A40/24X,"  TO  ENDFILE  " , A4 

*1X,"  STARTING  AT  HOUR  ",13/ 

6/lX,"  TIME  SERIES  PARAMETERS  P  =",I4,"  Q  =",I4,"  R  =",I4,, 
7 / IX,  "  HEIGHT  RANGE,  MAXIMUM  ",  15 , IX, "  MINIMUM  "  , 15  ,  /  '  ' IX, 
8"  POWER  SERIES  PARAMETERS ”// /29X , "NA" , 1 1 13 / /2 9X ,  'OB ",  1 1 1 3 / 
5/29X, "NC" , 11I3////1X, "  PERIOD", F7. 1, "  HOURS") 

SCATTERER  RATE  AS  A  FUNCTION  OF  TIME  AND  HEIGHT. 

NOP=NOP+l 

WRITE  (26,999)  FF,  RESULT, SOURCE, NOP 
999  F0RMAT(A1/72A1,8A1,26X, "PAGE", 13) 

WRITE(26,4000)  NTIME 

4000  FORMAT)//"  SCATTER  RATE  AS  A  FUNCTION  OF  TIME  AND  HEIGHT." 
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o  n  o  o  on 


HEIGHT  ,  24  :  5  .■  LX  ) 

NH=  iMGvX-MIX)  '3-i 
DO  40  2  2  K=  I ,  L;h 
M2=MAX-  ;  i 
KK.  =  X'H-K+2 

WRITE  (  2  6 , 4  C  C  i  )  NZ ,  (MLIO  f  KK ,  G . 
4001  FORMAT ( IX, 15 , 2X,  2415 '  ■  ) 


,  24  ) 


TLE  ECHO  R.A 


MAP 


M  “ECHCF.ATE" 


ECHORATE="ECHORATE  “ 

CALL  SDE3IG  ( ECHORATE , CADD) 

OPEN  (  12  ,  FILE  =  ECHORATE,  FORM=  " TNFORM-ATTED “  i 
WRITE  ( 12 )  (MNO (KK, J) , J=1 , 24 ) 

40Q2  CONTINUE 

CLOSE  (12) 

IF'M.GT. 120)  GO  TO  400 
NBOMB=3 
GO  TO  1102 

INVERSION  OF  Q,  AND  FORMATION  OF  COEFFICIENT  COLUMN  AC. 

400  CONTINUE 

DO  101  J=1,N 
DO  101  K=1,N 
A(J,K)=Q(J,K) 

101  CONTINUE 
NBOMB=4 

WRITE  (*,*)  M,  ■'  POINTS  PROCESSED" 

WRITE  (  * , * )  "  " 

WRITE  (*,♦)  "  ATTEMPTING  INVERSION  OF  MATRIX  Q  (TO  A)  " 

WRITE  (  *  ,  *  )  "  " 

CALL  MATSIN (A, N, DETERM) 

IF (DETERM. GT. -12 . 0)  GO  TO  1103 
1102  WRITE(25, 1104)  FF,  RESULT , N, M, DETERM, NBOMB 

1104  F0RMAT(A1////1X,72A1////1X,52K  ****  ERROR  IN  INPUT  DATA  HAS 
RESULTED 

1  IN  MATRIX  Q(I3,1H,I3,34H)  BEING  UNSUITABLE  FOR  INVERSION.,.'  '/ 


2  10X,50H 


$$$S$ 


$$$$$ 


$$$$$ 


$$$  $  $ 


C 

c 

c 


31X,13H  DETERMINANT  ,  E12 . 4  /  /  /  IX ,  18H  CONTINGENCY  LEVEL ,  1 5  /  /  ,' 
41X,30H  PROGRAMME  CANNOT  BE  CONTINUED) 

PAUSE  "  NON-INVERTABLE  MATRIX  Q  -  CHECK  DATES  IN  TGRODAl 
GO  TO  302 

FORMULATE  MODEL  COEFFICIENTS  (  AC  ) 

1103  CONTINUE 

DO  103  K=1,N 
DO  103  J=1,N 
AC(K) =AC(K) +P(J) *A(J,K) 

103  CONTINUE 

DO  104  J=1,N 
DO  104  K=1,N 

SUM1=SUM1+AC ( J) *AC(K) *Q(J,K) 

104  CONTINUE 

DO  105  J=1,N 
SUM2=SUM2+AC ( J) *P ( J) 
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MOF^MOP^i 

WRITE  (2o,393)  FF,  RESULT,  SOURCE,  ^;OF 
WRITE (26, 35)  DETERM, W 

35  FORMAT(/36H  LOG  (BASE  ^0)  OF  MATRIX  DETERMIMATIT ,  El  3  . 
*  /  '•  COLUMN  MATRIX  AC  (  "  ,  13  ,  “  )  “  IX) 

LINE=0 
;'IA=N/2  +  i 
DO  205  I=1,MA 

2C8  WRITE  (2  6, 209)  AC  ( I )  ,SIGMJ^.  (I>  ,AC(I-MA)  ,S:GMJi(  I*M-.A) 

209  FORMAT (13X, 2 ( 13X, F7 . 2 , 3X, F7 . 1 ) ) 

LINE=LINE'^1 

IF  (LINE.LT.42)  GO  TO  205 

LINE=0 

NOP=NOP+l 

WRITE  (26,999)  FF,  RESULT, SOURCE, NOP 
WRITEv26,36)  N 

36  FORMATdX//"  COLUMN  MATRIX  AC  (",  13  ,“  )  (CONTD)  "/IX) 
205  CONTINUE 

WRITE(25,*)  "  AC  RECORDED" 

IF  (PERIOD. NE. 24.0)  GO  TO  300 
WRITE  (*,*)  "  CALLING  SDI.ANA" 

CALL  SDIANA 

WRITE  (*,*)  "  DIURNAL  VARIATION  COMPLETED" 

WRITE  (25,*)  "  DIURNAL  VARIATION  COMPLETED" 

300  WRITE  (*,*)  "  CALLING  SVARY" 

CALL  SVARY 

WRITE  (*,*)  "  TIDES  FILED  " 

WRITE  (25,*)  "  TIDES  FILED  " 

IF  (PERIOD.NE.24 . 0  .OR.NPM.AX.GT.2)  GOTO  301 
C 

C  PREPARE  FILE  "GLDPRNT" 

C 

CALL  GPRINT7 
C 

C  PREPARE  INPUT  FILES  FOR  "WINGZ" 

C 

CALL  GROWZ  (CADD) 

WRITE  (25,*)  "  WINGZ  FILES  COMPLETED" 

C 

C  PREPARE  SPYGLASS  TRANSFORM  PLOT  FILES 

C 

TFILE="UUU" 

T4="T4U  " 

CALL  TRANS7  (TFILE,T4) 

TFILE="Ld’7" 

T4="T4V  " 

CALL  TRANS7  (TFILE,T4) 
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r4: 


109 


Tr 

"  >o/w  '■ 

T 

r'.AEIE 

WRITE 

'25,  *  ’ 

I TE 

*  ,  »  '  " 

CAL_  D 

a "  e  T 1 "  e 

I E  c,  C  —  — 

36 : :  «LH 

IEEC= I 

3ECj  I E 

JHCUR= 

?  c  ■’ 

JMIM= I 

EEC  ■■  5  :  - 

us EC = I 

SEC-.IHO 

WRITE 

(  *,  INC) 

FORMAT 

(  /  ■  " 

TO  PROCESS  " 

WRITE 

(25,107 

'WRITE 

(26, 107 

WRITE 

(25, 108 

FORMAT 

{ "  sue 

CLOSE 

(25) 

CLOSE 

(26) 

WRITE 

(  *  ,  *  )  " 

WRITE 

(  M08) 

WRITE 

(  *  ,  *  )  " 

'WRITE 

(  *  ,  *  )  " 

WRITE 

(  *  ,  *  )  " 

WRITE 

(  '  ,  *  )  " 

WRITE 

(  *  ,  *  )  " 

WRITE 

(  *  ,  *  )  " 

PAUSE 

STOP 

WRITE 

(  *  ,  *  )  " 

PAUSE 

"  ERROR 

WRITE 

(25, 109 

FORMuAT 

(  "  ERR 

'WRITE 

(26, 103 

CLOSE 

(25) 

CLOSE 

(26) 

STOP 

END 

ROGRA.M  TOOK  "  , 

"  p-r'wnc'c”  i 


'TEC,M 
'SEC,  M, 

;tion  c 


ISN'T  THIS  F'CN?" 


HIT  RETIRN  -TO  El 


!02") 


SUBROUTINE  DateTime 

IMPLICIT  NONE 

ir.teger *4  month ,  day  ,  year ,  hour ,  minute ,  second 

COMMON/TEMPO/year, month, day, hour , minute , second 
C  define  a  datetime  record,  structure  and  corriments  taken 
C  from  Inside  Macintosh,  Vol  2,  page  373 

RECORD  DateTimeRec/  DateTime 

CALL  GetTime (DateTime ) 
month^DateTime . m.onth 
day =DateTime . day 
year=DateTime . year 
hour=DateTime . hour 
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4  MYRDAY= ?0+JO^l 
RETURN 


5  MYRDAY  =  12  0*JO-^L 
RETURN 

6  MYRDAY=151^J0^L  ♦ 

RETURN 

7  MYR3AY=131+JO+L 
RETURN 

8  MYRDAY=212+JO+L 
RETURN 

3  MYRDAY=243+JO+L  ^ 

RETURN 

10  MYRDAY=27  3-t-JO  +  L 
RETURN 

11  MYRDAY=304+JO+L 
RETURN 

12  MYRDAY=334+JO+L 

RETURN  • 

END 
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FRCCEJ 


*  FVMiTC  >  111  ,  D  <  2  )  ,  P  I  220  )  ,Qi2F 

*  ^  ^  f":  V  i  '  "  1 


C 

C 

C 


f'OMMOi’  '.OIO'.P'O'  '~,  '.'Or  ,  ZMIM,  MIM,  Z'-L- 

*MCO,  zuM,  AC,  M?,  ‘;q,  ^:= ,  resvlz,  _ 

*EF, CADD, Z 

COMMON  'ECHCEZ  ?, VEl , SIMJ , COS J , OCI 
*D,  3IGr4A 


CALCULATE  NORMUVLIZED  HEIGHT  OF  SCA 
3=  (2 . 0*Z-ZMAX-2MIM)  (ZMAX-2MIN)  +1  . 


C 

SUMP  =  0  .  0 
SUMQ=0 . 0 
SUMR=0 . 0 
NCOUNT=0 
1000  NAOT=2*NAO 
SUMSAO=l 

IF(NAOT)  110,110,84 

84  DO  8  K=2,NAOT,2 
SUMSAO=SLFMSAO+S**K 

8  CONTINUE 

IF(NP)  110,110,85 

85  DO  10  J=1,NP 
NA2=2»NA(J) 

SUMSA(J) =1 

DO  9  K=2,NA2,2 

9  SUMSA(  J)  =SLT>1SA(J) +3**K 
SUMP  =  S'JMP-i-SUMSA(  J) 

10  CONTINUE 

110  SUMP=SUMP-3UMSAO 
NBOT=2*NBO 


SUMSBO=l 

IF(NBOT)  130,130,114 

114  DO  11  K=2,NBOT,2 
SUMSBO=SUMSBO+S**K 

11  CONTINUE 

IF{NQ)  130,130,115 

115  DO  13  J=1,NQ 
NB2=2*NB( J) 

SUMSB(J) =1 

DO  12  K=2,NB2,2 

12  SUMSB(J)=SUMSB(J)+S**K 
SUMQ=SUMQ+ SUMSB ( J ) 

13  CONTINUE 

13  0  SUMQ=SUMQ  +  SrjMSBO 
NCOT=2*NCO 
SUMSCO=l 

IF{NCOT)  160,160,135 
135  DO  14  K=2,NCOT,2 

SUMSCO=SUMSCO+S**K 
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16  co::ti>jue 

lo  :  S -'MR  =  SUMR-^S'JMSCO 

Wr=l.C/  (  (DCL**2)  ’  SUM?  *  l  DCM*  *2  )  *  SUMQ+ !  SCR' *  *  2  *2 

SUM3  =3UM3  +WF*VSL**2 

MA0E=MA0-^1 

DO  20  K=l,NAOE 

N'COUN?  =  NCOUMT*  1 

2  0  D  ( MCOrjMT )  =  DCS  *  (  3  *  *  (  K  -  2  !  I 

IF(NPi  322,222,320 

3  2  0'  DO  21  J=1,NP 

NAE=NA( J) -I 
DO  21  K=1,NA£ 

NCOUNT=NCOUNT+l 

21  D(MCOUNT)  =0012*  {S*‘  (K-1)  !  *3INJ(Ji 
DO  22  J=1,NP 

NAE=NA(J) +1 
DO  22  K=1,NAE 
NCOUNT=NCOUNT+l 

22  D(NCOUNT) =DCL* (S** ;K-1) ) *COSJ(J) 

322  NBOE=NBO+l 

DO  23  K=l,NBOE 
NCOUNT=NCOUNT+l 

23  D(NCOUNT) =DCM* iS** (K-1) ) 

IF(MQ)  325,325,323 

323  DO  24  J=1,NQ 
NBE=NB(J) +1 
DO  24  K=1,NEE 
NCOUNT=NCOUNT+ 1 

24  D(NCOUNT) =DCM* (S*» (K-l) ) *SIMJ(J) 

DO  25  J=1,NQ 

NBE=NB ( J) +1 
DO  25  K=1,NBE 
NCOUNT=NCOUNT+ 1 

25  D(NCOUNT) =DCM* (S** (K-1) ) *COSJ(J) 

325  NCOE=NCO+l 

DO  26  K=l,NCOE 
NCOUNT=NCOUNT't-l 

26  D(NCO™t)  =DCN*  (S**  (K-1)  ) 

IF(NR)  328,328,326 

326  DO  27  J=1,NR 
NCE=NC ( J) +1 
DO  27  K=1,MCE 
NCOUNT=NCOUNT+ 1 

27  D(NCOUNT) =DCN* (S** (K-1) ) *SINJ(J) 

DO  28  J=1,NR 

NCE=MC  (J)  --1 
DO  28  K=1,NCE 
NCOUNT  =NCOUNT  + 1 

28  D( NCOUNT) =DCN* (S** (K-1) ) *COSJ(J) 

328  DO  29  J=1,N 
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29 


COfj'T  22;VE 
DO  30  J=:,M 
DO  3  0  K  = 1 , M 
Q( J, K) =Q!J, K) 

comt:o;ue 

RETORM 

END 


C 

r 

C 


SUBROUTINE  GMONTH  (RMOMTH,!) 

MARCH  3 

DETERMINES  HOLERITH  MONTH 

CHARACTER* 4  MO { 12 ) , RMONTH 
INTEGER*4  I 

DATA  MO/"  JAN","  FEB",“  MAR", 
* "  AUG" , "  SEP" , "  OCT" , "  NOV" , " 
IFd.LT.O  .OR.I.GT.12)  GO  TO  1 
RMONTH=MO ( I ) 

RETURN 

1  WRITE (*, 100)  I 
100  FORMAT (" ILLEGAL  MONTH  “,I5) 
PAUSE 
STOP 
END 


APL"  ,  “ 
DEC"/ 


MAY"  , 


JUN","  JLY", 
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on  non  nnnnnno 


DIMENSION  IH (47) , AM(765 ) , ER(I65) , AO i 151 ) , A”24 ( 15 : ! , PHI 4 
*AU12 (153 )  , FH12 (153 ) , EO( 153) , ER24 I  153 )  , ERPH24 i 153 )  , ER12 ' 
*ERPH12 ( 153 ) 

CHARACTER* 1  FF , WHERE ( 32 )  , RESULT  <  72 )  , SOURCE ' 5 ) 
CHARACTER*4  CADD, FILE, FMONl , FMON2 
CHARACTER* 40  GLDPRNT 

COMMON /WINDS/  N ,  Q  (  2  00 , 2  00  )  ,  MO?,  ZMIN,  MIM,  2MAX,  M.AX, 
*NA(10)  ,NB(10)  , NCI  10)  ,NAO,N3O,NCO,SUM,AC(2C0)  , 

*NTIME(24) ,MP,NQ, NR, RESULT, SOURCE, PERIOD, 

*FF, CADD 

MHITE=MAX-MIN+1 

NHlTE=MHITE-4 

IHITE=15*MHITE 

OPEN  ( 5, FILE="7DATES" , FORM= " FORMATTED" ) 

REWIND  (15) 

REWIND  (16) 

GLDPRNT= "GLDPRNT  " 

CALL  SDESIG  (GLDPRNT , CADD) 

OPEN  ( 17 , FILE=GLDPRNT, FORM=“ FORMATTED" ) 

CHECK  DATES 

WRITE  (*,*)  "  LOOKING  FOR  FILE  DATES." 

GO  TO  11 

ENTER  DATA  INTERVAL  IF  FILE  IDATES  MISSING 
9  WRITE (*,98) 

9  8  FORMAT ( " ENTER  DATA  INTERVAL ;  MONTH , DAY , MONTH , DAY , YEAR , 

*  WHERE  (3X,A4, I3,2X,A4, 13, IX, I5/32A1) " ) 

READ ( * , 99 , ERR=9 )  FMONl , JOl , FMON2 , J02 ,  RTPEAR, WHERE 
99  F0RMAT(/3X,A4, I3,2X,A4, 13, IX, I5/32A1) 

GO  TO  12 

1 1  READ (5,99, ERR=  9 )  FMONl , JOl , FMON2 , J02 , MYEAR , WHERE 
CLOSE  (5) 

INITIALIZE 

12  DO  10  I=1,NKITE 
IH(I) =MAX+1-I 

10  CONTINUE 

READ  AMPLITUDES,  PHASES  AND  ERRORS 


164 


non 


c 


i  I  ,■  5 )  ^  I 
AO ( J ) =AM ( I ) 

Au  2  4 ( J ) - AM ( I  +  1  I 
FH24  (  J)  =:AM(  I>2) 

AU12  ( J)  =AM(  1-^3  ) 

PH12 ( J) =AM ( 1^4 ) 

EO(J) =CR( I) 

ER24 (J) =ER(I+1) 

ERPH24 (J) =ER(I+2) 

ER12 (J) =ER{I+3) 

ERPH12 (J) =ER(I+4) 

8  CONTINUE 

OUTPUT  EAST-WEST  WIND  COMPONENTS 
WRITE (17, 100)  CAOD, WHERE 

100  F0RMAT(1X,A4/12X, "EAST-WEST  WIND  COMPONENTS,  ",2X,32A1/' 

WRITE (17, 101)  FMONl, J01,FMON2, J02,MYEAR 

101  FORMAT ( 12X,A4, 13, "  -  ",A4,I3,IS) 

WRITE(17,  102) 

102  FORMAT (38X, "24  HOUR  12  HOUR",/ 

*12X, "HEIGHT  MEAN  ERROR  AMP  ERROR  PHI  ERROR 
*  AMP  ERROR  PHI  ERROR"/) 

DO  1  I=7,NHITE,4 

WRITE  (17,  103)  IK(I)  ,  AOd)  ,  EO(I)  ,  AU24  (I)  ,  ER24  (I)  ,  PH24  (  I)  ,  EPPH24  ! 
*AU12(I) ,ER12(I) ,PH12(I) ,ERPH12(I) 

103  FORMAT (12X, 14 , F8 . 0 , F5 . 0 , 4 ( F6 . 0  ,  F5 . 0  )  /  ) 

1  CONTINUE 
C 

C  OUTPUT  NORTH -SOUTH  WIND  COMPONENTS 

C 

KHITE= (NHITE-6) /4+1 
IF  (KHITE.GT.6)  WRITE  (17,1040)  FF 
1040  FORMAT  (Al) 

WRITE (17, 104)  CADD, WHERE 

104  FORMAT ( IX, A4/12X, "NORTH -SOUTH  WIND  COMPONENTS  ",32A1/) 

WRITE (17, 101)  FMONl, J01,FMON2, J02,MYEAR 

WRITE (17, 102) 

DO  2  I=7,NHITE,4 
J=I+MHITE 

WRITE (17 , 103 )  IH (I) , AO(J) , EO( J) , AU24 (J) , ER24 ( J) , 

*PH24 ( J) , ERPH24 ( J) , AU12 ( J) , ER12 ( J) , PH12 ( J) , ERPH12 ( J) 

2  CONTINUE 
C 

C  OUTPUT  VERTICAL  WIND  COMPONENTS 

C 

IF  (KHITE.GT.6)  WRITE  (17,1040)  FF 
WRITE (17, 105)  CADD, WHERE 

105  FORMAT ( IX, A4 /I 2X, "VERTICAL  WIND  COMPONENTS,  ",3X,32A1/ 
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WRITE  '  2:; ,  102  i 


ICc  FORMAT ("  GLDFRMT  FILEC") 

CLOSE  (15) 

CLOSE  (16) 

WRITE  (17,i04j)  FF 
CLOSE  (17) 

RETURN 

13  WRITE ( * , 107 )  FILE 

107  FORMAT ("  NO  DATA  IN  FILE  “ , A5 ) 
STOP  "  ERROR  TERMINATION" 

14  WRITE ( * , 108 )  FILE 

108  FORMAT!"  ERROR  IN  DATA  FILE  " , A5 ) 
PAUSE  "  ERROR  TERMINATION" 

STOP 

END 
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r; 

C 

C 

c 

c 

c 

r 

C 


AND  INPUT  FILE  XXXXARCHIT 

WHERE  XXXX  ID  THE  FILE  DEDIGNATOR  “CADD" 

[NOTE  THAT  X  ID  A  DUMT-’Y  BLOCK 

INTO  WHICH  WINDS  ABOVE  IMKM  AI:D  BELOW  riKM  ARE  READ 
OUTPUT  FILES  ARE  DEFINED  ONLY  BETWEEN  -I  AIJD  IIIKM.; 


DIMENSION  U(25,41) ,V(25,41) ,W(25 

CHARACTER*!  TAB 

CHARACTER* 4  CADD 

CHARACTER  *  4  0  ARCH IT , WZF I LE , OUTF I 

C0MI40N/HEIGHTS/N0Z 


WRITE  (*,*)  "  SUBROUTINE  GR0W2-  PREPARING  WINGZ 

WRITE  (*,*)  "  FROM  GROVES  ZONAL,  MERIDIONAL  AND 

*  OUTPUT  (IN  ARCH IT) " 

OPEN  ( 15, FILE="UUU" , FORM= " FORMATTED" ) 

OPEN  ( 16,  FILE="'v"/'v  "  ,  FORM=" FORMATTED”  ) 

OPEN  ( 17 , FILE="WWW" , FORM= " FORMATTED" ) 

ARCH IT=" ARCH IT  " 


CALL  SDESIG  ( ARCHIT, CADD) 

OPEN  ( 18 , F I LE=ARCH IT, FORM=" UNFORMATTED" ) 
ITAB=9 

TAB=CHAR ( ITAB) 

N=0 

10  DO  11  1=1,6 

READ  (18)  NZ(I) , (X(J, I) , J=l,25) 

11  CONTINUE 

DO  1  1=1, NOZ 

IF  (N.EQ.O)  READ  (18)  NZ ( I ) ,  ( U ( J , I )  ,  J= 1 , 2 5 ) 
IF  (N.EQ.l)  READ  (18)  NZ ( I ) , ( V ( J , I ) , U= 1 , 2 5 ) 
IF  (N.EQ.2)  READ  (18)  NZ ( I ) , (W ( J, I ) , J=1 , 25 ) 

1  CONTINUE 
DO  2  1=1,4 

READ  (18)  KZ, (X(J, I) , J=l,25) 

2  CONTINUE 


N=N+1 

IF{N.LE.2)  GO  TO  10 
CLOSE  (18) 

DO  4  J=l,NOZ,2 

WRITE  (15,100)  NZ(J) ,TAB, (U(I,J) ,TAB,I=1,24) ,U(25,J 
WRITE  (16,100)  NZ{J) , TAB, (V(I,J) , TAB, 1=1,24) ,V(25,J 
WRITE  (17,100)  NZ(J) ,TAB, (W{I,J) ,TAB,I=l,24j ,W:25, J 
100  FORMAT  (I6,A1,24(F8.2,A1)  ,F8.2) 

4  CONTINUE 
CLOSE  (15) 

CLOSE  (16) 

CLOSE  (17) 


OUTFILE=" ZONAL 
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r 


I 


i 


c 

c 

c 

c 

c 

c 

c 


c 

c 


IF  IT  CONTAINS  NOTHING  3L'T  A  ’=TAI;k  CHAFACTF?.  . 

INTEGER  ROW  (OP.  COLOLN)  OSSIGNATOR  FIEICS  MOST  ENT 
A  BLANK,  OTHERWISE  THEY  MAY  APPEAR  AS  FIOATII.'G  POINT  NYMEERS  . 


INTEGER*!  IHR,JHR 

integer*2  if, ITAB, LCHAR,NT0F, ISTOP, STRTHR 
INTEGER  *  4  NCHAR ,  L  IiN’ES 

CHARACTER*!  BLANK, HR(14) ,HOUR(!04) ,REFMT(250) , TAB 
CHARACTER*40  OUTFILE, IMFILE 
COMMON/ HRSTRT/  STRTHR 
COMMON / HE IGHTS / NOZ 

OPEN ( 15 , FILE= INFILE, FORM= "UNFORMATTED" ) 

OPEN( 16 , FILE=OUTFILE, FORM="FORMATTED" ) 

LINES=NO.  OF  LIMES  IN  INPUT  FILE. 

NCHAR=NO.  OF  CHARACTERS  PER  LINE. 

LINES=NOZ/2+! 

NCHAR=232 
BLANK= "  " 

148=48 

ITAB=9 

TAB=CHAR ( ITAB/ 

IHR=STRTHR/10 
JHR=STRTHR- 1 0  * IHR 
HR{1)  =CHAR(IHR-^I48) 

IF(IHR.EQ.O)  HR(1)=BLANK 
HR(2) =CHAR(JHR+I48) 

J  =  0 

DO  1  1=1, 11,2 
J=J+1 

JSTRT  =  STRTHR+4  * J 

IF ( JSTRT . GE . 24 )  JSTRT=JSTRT-24 

IHR=JSTRT/10 

JHR=JSTRT-10*IHR 

HR (1+2) =CHAR{IHR+I48) 

IF(IHR.EQ.O)  HR(I+2)=BLANK 
HR(I+3) =CHAR(JHR+I48) 

1  CONTINUE 

DO  10  1=1, 104,4 
HOUR ( I ) = BLANK 
HOUR(I+l) =BLANK 
HOUR ( 1+2 ) =BLANK 
HOUR (1+3 ) =TAB 
10  CONTINUE 
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2 

20 


3 


HO'’P  ■ 

''  r 

'  ) 

ur  , 

--  -  ' 

-nr  l  4  / 

HCl^R  ( 

;  ~  ■, 

-  HR  i  5  } 

HOUR  ^ 

i  -  ) 

=HR ! 6 ) 

HOUR  ! 

53  1 

=  HR (7  i 

1 

5  4  ) 

“  H  :  -  ) 

HCUR  ( 

P  i*  ) 

=HR ; 3 ) 

HOUR  1 

7C  1 

=HR (10) 

HOUR  i 

3  E  } 

=HR Ill) 

HOUR ( 86 ) 

=HR( 12) 

HOUR  ( 

1 0  1 

) =HR ( 13 ) 

HOUR  ( 

) =HR ( 14 ) 

WRITE 

(  * 

,  ♦  )  "  P 

ARING  ".OUTFILE 
WRITE  (16,100)  IHOURdH)  ,  IH  =  1,  103  ) 
FORMAT ( 103A1 ) 

DO  5  1=1, LINES 

READ  (15)  (REFMTCC)  ,  :C=l,i;CHAR) 

NTOP=NCHAR 

IF  =  7 


IF=IF+1 

IFdF.EQ.  ISTOP)  GO  TO  4 

IF (REFMT ( IF) .NE. BLANK)  GO  TO  2 

KTOP=NTOP-IF 

DO  3  KK=l,KTOP 

REFMT ( IF-l+KK) =REFMT ( IF*KK ) 

CONTINUE 

NTOP=NTOP-l 

ISTOP=NTOP-l 

GO  TO  20 

LCHAR=NTOP-l 

WRITE  (16,101)  ( REFMT ( IC ), rc=l 

FORMAT (250A1) 

CONTINUE 
CLOSE  (15) 

CLOSE  (16) 

RETURN 

END 


LCHAR ) 
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COMMON,  HRSTP.T.  CTF.THR.  PNCCOr 

COMMON /WINDS'  M,Q,  I'OP,  ZMI’C  MIN,  CMAX ,  MAX ,  :;A  ,  NE  ,  NC  ,  NAI  ,  I;e  ,  , 
*NCO,  SUM,  AC,  NTIME,  ,NQ,N;  ? ESVCT ,  CCCPCE  ,  ?5?  lOD, 

*FF, CADD, Z 

COMMON,' ECHOES  ?  ,  VEL ,  S  INC  ,  CCS  '  ,  DCl ,  DCM ,  DON,  CCMl ,  CCM„  ,  COM  ■ 
*D, SIGMA, A2ENM:N,AZENMAX, IEND 
COMMON,/ EXTRAS/  ILCNIT,  ICADD,  .N’GO,  STRTDA,  E.NDDAV,  LEARC?  ,  .AMO, 
*MNO  (  2C  ,  24  )  ,  NFILE,  LENGTH,  NEG,  :;?MAX,  ZERO,  ^:F?,:NT 
COMMON ,/  F3  F  EC  /  I F I  IE ,  DUMMY  ,  I  r;START  ,  I  NEI:D  ,  NSTAFT  ,  N  FO I  NTS 
COMMON,'  HEIGHTS .  NOZ  ,  NQUAD 
COMMON/TEMPO/  IDATE,  LHOUP. ,  LMIN,  LCEC 
EQUIVALENCE  ( DUMSTA, IN3TAFT ! 

EQUIVALENCE  (DUMEND,  II-'END) 

C 

C  FILE  ORGANIZATION 

C 


WRITS  (  *  ,  *  )  " 

GROVES  Al.'ALYSIS" 

WRITE  (*,*(  " 

" 

WRITE  (  ’  ,  *  )  " 

READING  OUTPU:  FILE  3DESIGNATO?” 

OPEN  (25, FILE 

="CADDSFEC" , FOKM=" FORMATTED" ) 

READ  (25,98) 

ICADD 

FORMiAT  (611) 

CLOSE  (25) 

ADD=48 

CADD ( 1 ) =CHAR 

(ADD+ICADD(1)  ) 

CADD  f  2 ) =CHAR 

(ADD+ICADD(2) ) 

CADD ( 3 ) =CHAR 

(ADD+ICADD(3)  ) 

CADD (4 ) =CHAR 

(ADD-i-ICADD(4  )  ) 

CADD ( 5 ) =CHAR 

(ADD+ICADD(5) ) 

CADD ( 6 ) =CHAR 

(ADD..-ICADD(6)  ) 

V/RITE  (*,99) 

ICADD, CADD 

FORMAT  (411,3 

X, 4A1 ) 

DIAGS="DIAGS 

M 

CALL  SDESIG  (DIAGS,CADD) 

OPEN  (25 , FILE=DIAG3, FOPM=" FORMATTED" ) 
OPEN  ( 5 , FILE= " 7GRODAT" , FOPM= " FORMATTED" ) 
IUNIT=1? 

2ERO=0 

FF=CHAR(12) 

SPECIFY  CENTURY 
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c 

c 

c 


RH:AD  ;  o  ,  :  J  ,  ENr'  =  ;  )  etrtea.enddav 

3  3  FORMAT ' T  — 

READ  (  5  ,  3  4  ,  E';D  =  3  3^3  I  A0E3:MIM,  AZRrJMAX 
3  4  FORMAT  I  3  FT .  3 ) 

READ  (5,34,  E.OD=2  3^  )  RT.'GCOR 
IF  (AHS(RMGCOR) .GT.13)  FACS-  ”  BAD  RI 
*  TYPE  CONCMAMD  PERIOD  TO  EDIT  ” 

WRITE  (*,35)  STRTDA , ENDDAV , STRTHR , A2 
35  FORMAT{F7.G, 3X,F7.0, 3X, 15, 3F5.:,  “  I 
IMYMO  =  STP.TDA  /  100 
rMY=IMYMO,'100 
DEAF  =  {MYR19-IMY!  ,'4 
LEAP=LEAF*4- (MYR19+IMY) 

IF (LEAP. EQ. 0)  LEAPYR=1 
IMO=IMYMO-IMY*100 
GROOUT="GROOUT  " 

CALL  3DESIG  (GROOUT, CADD) 

OPEN  (26, FILE^GROOUT , FORM= ” FORMATTED" 

INITIALIZATION 

NEOMB=0 
NEG  =  0 
NRDERR=0 
DO  500  IT=1,24 
IHR=IT-3TRTHR-1 
IF(IHR.GE.24)  IHR=IHR-24 
NTIME ( IT) =IHR 
iOO  CONTINUE 

DO  38  1=1,200 
P(I) =0.0 
D(I)=0.0 
SIGMA(I) =0.0 
AC ( I ' =0 . 0 
DO  38  L= 1,200 
Q(I,L)=C.O 
i  rONTIlTJE 
NUMNA=  0 
NUMNB=0 
NUMNC=Q 
3UM1=0 . 0 
3UM2  =  0.0 
F  YM  3  =  0. j 

V-  i" 

:]o?=o 

DO  33  1=1,10 
NA ( I ) =  0 
N3  (  I )  = : 

NC ( I )  =  3 


l-'O  1  *  -  =  .  , 
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fil  n) 


o  n  n 


■  ^  i  ■"  F  ;  •  ;  =  '  n ; 


READ  ARID  FRIM: 


READ { IF , FFD )  REEDLT , DODRCE 
9?C  FORMAT (72A1, 5A1) 

CLOSE  (16) 
rjOP  =  l 

WRITS (26 , 5?8 )  RESULT, SOURCE, KDATE, IDATEi 3 i , I DATE ( 1 ; , TO? 
998  FORMAT  ( // ■' /  IX,  7  2A1,  3AI,  4X,  6HRUN  ON,A4,;3,"  1  9  "  ,  12  ,  3  X ,  "  F.- 
*13////  ) 

WRITE  (25,998)  RESULT ,  SOURCE ,  KDATE ,  ID.ATE  (  3  )  ,  I  DATE  <'  1  i  ,  L'OF 


THIS  SECTION  OF  THE  PROGRAM  READS  PROCESSING  PARAMETERS. 


MBOMB=NBOMB+l 

IF(STRTDA.GT.ENDDAY)  GO  TO  299 
IF(ENDDAY.EQ.O)  GO  TO  6 
JUMP=0 

JMYMO-ENDDAY.'IOO 
IJO=STRTDA-IMYMO*IOO 
J JO= ENDDAY - JMYMO  *  1 0  0 
JRr/=Jm'MO/ 100 
JMO = JMYMO - JMY  *  1 0  0 
GO  TO  7 

299  NBOMB=NBOMB+l 

WRITE (2 5, 210)  FF,  NEOMB 
210  F0RMAT(A1////1X, "EXIT,  CONTIGENCY  LEVEL" 

ILE  5") 

PAUSE  "MO  DATA  IN  FILE" 

STOP 

6  JUMP=1 
EMDDAY=1 . OE+06 

7  CONTINUE 

READ (5,1)  NP,NQ,NR 

1  FORMAT (2413) 

NPMAX=NP 

IF(NQ.LE.NPMAX)  GO  TO  60 
NPMAX=NQ 

60  IF(MR.LE.NPMAX)  GO  TO  61 

M'?MAX=NR 

61  CONTINUE 

READ  (5, 2)  ZMIN,Z:LAX 

2  FORMAT ( IX, 2F4 . 0 ) 

WRITE  (*,*)  ZMIi;,ZMAX 
MIN=ZMIN 


12 ////IX, "NO  DATA 
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MA  - 


BOMB  “ j ECME  ^  1 


} 


O’BCMB 


•  c'v-r 


J  •  'M?  -  1 

BNDDAY.l  .  CE;-;B 


► 


C 


6  3 


C 

I  56 


coNT  irrjE 

READ  (5,1)  .\’P,  NO,  l.’R 
FORMAT (2413) 

MPMAX=NF 

IF'.NQ.  LE.NF^LAX)  GO  TO  c'C 
MFMAX=NQ 

IF(MR.LE.NPMAX)  GO  TO  61 

NPNLAX  =  NR 

CONTINUE 

READ (5, 2)  ZMIN,ZMAX 
FORMAT! IX, 2F4.0) 

WRITE  (*,*)  ZMIN,ZMAX 
MIN=ZMIM 

MA  CHECK  TO  SEE  IF  WINDS 

IF(NCO.GE.O)  GO  TO  36 

NEG=-1 

NCO=0 

NR=0 

NC ( 1) =0 


CONSIDERED  TO  BE  HORIZONTAL 


C 

36  CONTINUE 

DO  19  J=1,NR 
1 9  NUMNC = NUMNC + NC ( J ) 

N  =  3  +  NAO + NBO + NCO+  2  * ( NP + NQ  *  NR -NUMNA + NUMNB  ^  NUMNC ) 

WRITE  (*,*)  "AC ( ” , N, " ) " 

IF(N-200)  4,4,3000 
3000  WRITE(25, 3001)  FF,N 

30G*  FORMAT(Al////lX,9HEXECUTION  ///// 

+1X,8H  ****, 3X, 16HDIMENSION  OF  N  (,I4,23H  )  EXCEEDS  THAT  1 

2//,T'lX,3K  ****, 3X, 29HPROGRAMME  CANNOT  BE  CONTINUED.  '  i 

PAUSE  "  MATRIX  >  200*200" 

STOP 

4  CONTINUE 
NE=N+1 
N2=2*N 


C 


C  GET  NAME  OF  SPP  INPUT  FILE 


WRITE  ( * , * )  "  " 

WHICH="  FIRST" 

WRITE  (*,3002)  WHICH 

3002  FORMAT  ("  ENTER  INTEGER  PART  (XXX)  OF  " , A6 , "  FILEN.AME 
READ  (*,*)  IFILE 
INSTART="SPP  -  GR  " 


I 


ALLOWED 
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DUMSTA  ;  .  :  I  =CHA?. 
DUM3TA  '  12  i  =CtiAP.  ( 
WHICH="  LAST" 


WRITE  (*,31  III  WHICH 
READ  ■>*,*■  IE1;D 

IWEND::"3??  -  OR  "  ^ 

I100=IEND, 1 30  • 

iic=(iEND-ii: :*io:)  i: 

I1  =  IEND- I  IOC* ICC -110*10 
DUMEMD( 10 1 =CHAR (1100-43) 

DL’MEND  (11)  =CHAR  (110-43) 

DUMEND ( 12 ) =CHAR ( 11-43 ) 

WRITE  (*,♦)""  # 


C  ENTER  NUMBER  OF  POINTS  PER  HEIGHT  TO  ER 

C 

WRITE  (*,3003) 

3003  FORMAT  ( "  NUMBER  OF  POINTS  PER  HEIGHT? 
READ  (*,*)  NPOINTS 

WRITE  {*,*)  '•  '■ 

C 

WRITE  (*,3004) 

3004  FORMAT  ("  PRINT  DATA  TO  SCREEN?  Y  OR  N 
READ  (*,3005)  NPRINT 

3005  FORMAT (Al) 

WRITE  (*,*)  "  " 

RETURN 

END 


PROCESSED 


"  /  3  ^ 


»  $  ) 
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JTAr.T  FROM  HOUR  STRTHF ,  THIU  SUBROUT IM 
r.FATS  RAU.AR.  rRAi*lE  HEADERS  AMD  R.ECCRDS 
FROM  OrATTERIM'G  FOIM’T  ?ARA0-!ETEF,  FILFS  OFT 
RECORDED  OH  HARD  DRIVE. 


THIS  SUSROUTIHE  PROCESSES  ALT  DATA  IH  THE  SE 
IMFUT  FITES,  SUBJECT  ONTY  TO  THE  SELECTIDIi  0 
ZENITH  .ANGTE3  .AND  DAY  ( 3 )  WILL  BE  PROCESSED, 
IN  FILES  7 DATES,  7 DUNK  A:;D  “GRODAT  . 


DIMENSION  P(200), 0(200,200),  NA(IO)  ,  NE  (1?  )  ,  NC  (  1 1  )  ,  AC  .  .1  ;U  , 
*SIGMA{2QQ) ,NTIME(24) 

REAL*4  SPBLOCK(IO)  ,SPSKIF(i:)  ,  FL.AG 

CHARACTER*!  NGO , YES , NO , NPRINT , RESULT ( 7 2 ) , SOURCE ( S ) , 
*C.ADD(6)  ,  FF ,  DUM(40) 

CHARACTER* 40  DUMMY, INSTART, INEND 
INTEGER*!  ICADD ( 6 ) , ZERO 
INTEGER*2  STRTHR 

INTEGER*4  M, IDATE(3) , ISECl, ISEC2, ISEC2  ,  ISEC4 
INTEGER*4  IFIX,SKIP 

COMMON/ HRSTRT/  STRTHR , RNGCOR, ISECl, ISEC2,  ISEC2 
COMMON/ WINDS /  N , Q , NOP , ZMIN , MIN , ZMAX , MAX , NA , NE , NC , NAO , NBO , 
*NCO , SUM , AC , NT IME , NP , NQ , NR , RESULT , SOURCE , PERIOD , 

*FF,CADD, Z 

COMMON/ ECHOES/  P, VEL, SIMJ ( 10 ) ,COSJ(!0) , DCL, DCM , DCN , SUM! , 

*  SUM2 , SUM3 , D , S IGMA , AZENMIN , AZENMAX , TEND 
COMMON /EXTRAS/  lUNIT, ICADD, NGO, STRTDA, ENDDAY, 

*  LEAPYR , JMO , MNO ( 2  0 , 2  4 )  , NFILE , LENGTH , NEG , NFMAX , ZERO , 
*NPRINT,DAY, JOBAD 

COMMON/GENE/  M,  UR ,  MY,  .MO,  JO,  LTIMH,  LTIMM,MSEC,  EL3  ,  EM3 

COMMON/FSPEC/IFILE, DUMMY, INSTART, INEND, NSTART, NFOINTS 

COMMON/HEIGHTS/NOZ,NQUAD 

COMMON/TEMPO/IDATE, LHOUR, LMIN, LSEC 

EQUIVALENCE ( DUMMY, DUM) 

DATA  MAPRD,NEXIT, RADIAN/0, 0, 57 .295779/ 

IF(MAPRD.EQ.l)  GO  TO  1 
WRITE  (  *  ,  * )  "  " 

WRITE  (*,*)  "  START  HOUR  ", STRTHR 

MAPRD=1 

UR=1 . 0 


TWOPI=6. 2831852 

FLAG=-999 . 0 

ONE=l . 0 

THREE=3 . 0 

LINE=0 

IHOLD=64 

LHOLD=-5 

MHOLD=0 

NZ  =  0 

M=0 

JSEC=ISEC1 
ISEC3=0 
NSTART =1 


JuMMY^  '•  Y? 


D'JM  !  ^  )  -L’HAP.  (  II  .  'j  *  c  } 

D':y.;  il;  :=cha?:i  :::  -  4b) 

Y":-:  I  lY  :  =YHAS  1:1-4-; 

AFEN  FIRYT  YFP  -  GR  XXX  DI3C  FILE 


C 


C 


c 


OPEN  (  22  ,  FI1E  =  D'JMMY  ,  FOPM^  "UIIFORMJ4TTED"  i 
WRITE  f  2  5 , 1 3 1 1 )  DUMMY 

WRITE  (*,*)  "  " 

WR I TE ( * , 9  9  5 )  NPO  r NTS , NQ”AD 

995  FORMAT  ("  PROCESS ING "  ,  1 3  ,  "  POINT  (S)  PER  IK.M  HSIGH'I 
*  IN  QUADRANT" , 13/ ) 

WRITE  (  *  ,  996  )  AZENMIM,  AZENICAX 

996  FORMAT ("  ZENITH  ANGLE  SPREAD" , F4 . 0 , “  TO  " , F4 .  /  ,  "  DEG 
ZENMIN-COS (AZENMIN/RADIAN) 

ZENMAX^COS (AZENMAX/RADIAN) 

YES="Y" 

MO="N'’ 

NFRAME=0 

NULL=0 

NH= (MAX-MIN) /3 -1 
WRITE  (  *  ,  *  )  "  " 

WRITE  (*,*)  "  " 

WRITE  (*,*)  "  »*****♦•  EXECUTION  PROCEEDING  ******** 
WRITE  (*,*)  "  " 

1  READ  (22,END=5)  SPBLOCK 

IF  (SPBLOCK( 1) .NE.FLAG)  GO  TO  2 
MY=SPBLOCK(2) 

MO=SPBLOCK(3 ) 

IF(M0.LT.1.0R.M0.GT.12)  GO  TO  4 
JO=SPHLOCK(4) 

LTIMH=SPBLOCK (5) 

LTIMM=SPBLOCK(6) 

MSEC=SPBLOCK(7) 

IF{LTIMH.EQ.LHOLD)  GO  TO  1 

MH=M-MHOLD 

MHOLD=M 

LHOLD=LTIMH 

LINE=LINE+1 

IF  (LINE. LE. 48)  GO  TO  195 

NOP=NOP+l 

LINE=0 

WRITE  (26,1003)  FF 
WRITE  (26,1004)  RESULT, SOURCE, NOP 
195  SPBLOCK (4 ) =JO 

SPBLOCK ( 5 ) =LTIMH 
SPBLOCK  (6)  ^LTIMI'; 

SPBLOCK (7) =MSEC 

WRITE  (*,998)  IFILE,  (.SPBLOCK' II)  ,  :i  =  2,  10)  ,MK 
993  FORMAT ( IX,  "SFP  -  GR  " , 1 3 , 9F8 . 3 , 1 3 ) 
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r 

I 


EL3=c:^;(c?HLOCK(3;  fadia:;; 

EM3=FIFi(3?5LOCK(4)  •PAFIANi 
EM3  =SQRr (0ME-EL3 'ELj -EM3 ‘EM: I 


C  CHECK  ZENITH  ANGLE 

IF  (EN3  .  LT  .  ZENTLAX.OR.  EN3  .GT.  ZE:Z-!:N;  GO  TO  1 

r 

Zr:SPBLOCK(l) 

C 

C  ELIMINATE  IF  LINEARLY  POLARIZED 

C 

ANGLE=S?BLOCK(6)  -EFBLOCK.O) 

IF  (ABS (ANGLE) . LT . 45 . 0 )  GO  TO  1 

IF  (ABS(ANGLE) .GT. 135.0. AND. AES(ANGLE) .LT. 225. 01  GOTO  1 
IF  (ABS(ANGLE) .GT. 315.0. AND. ABS(ANGLE) .LT. 360.0)  GO  TO  1 
C 

C  ELIMINATE  IF  X  POLARIZATION 

C 

IF  (ANGLE. GT. -135.0. AND. ANGLE.lt. -45.0)  GOTO  1 
IF  (ANGLE. GT. -135.0. AND. .ANGLE.lt. -45.0)  GOTO  1 
IF  (ANGLE. GT. 225.0. AND. ANGLE.lt. 315.0)  GO  TO  1 
C 

C  SELECT  QUADRANTS  TO  BE  PROCESSED 

C 

C  IF  NQUAD  =  0  PROCESS  ALL  QUADRANTS 

C  1  FIRST  AND  SECOND  QUADRANTS 

C  2  SECOND  AND  THIRD  QUADRANTS 

C  3  THIRD  .AND  FOURTH  QUADRANTS 

C  4  FOURTH  AND  FIRST  QUA^RAIITS 

C 

IF  (NQUAD. EQ.O)  GO  TO  25 
GO  TO  (21,22,23,24)  NQUAD 

21  IF  ( (EL3 .GT.ZIP.AND.EM3.GT.ZIP) .OR. ( EL3 . GT . ZIP . AND . EM3 . LT. ZIP) ) 
»GO  TO  25 

GO  TO  1 

22  IF  ( (EL3.GT.ZIP.AND.EM3.LT.ZIP) .OR. ( EL3 . LT . ZIP . AND . EM3 .LT.ZI?) ) 
•GO  TO  25 

GO  TO  1 

23  IF  (  (EL3.LT.2IP.AND.EM3.LT.ZIP)  .OR.  ( EL3 . LT . Z I? .  .AND . EM3 . GT . ZIP )  ) 
•GO  TO  25 

GO  TO  1 

24  IF  (  (EL3  .  LT.  ZIP..AND.  EM3  .GT.ZIP)  .OR.  (EL3  .  GT .  Z  IP  .  AND  .  EM3  .GT.  ZIP)  ) 
•GO  TO  25 

GO  TO  1 
C 

C  SELECT  NUMBER  OF  POINTS  AT  EACH  HEIGHT 

C 


I 
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3  DAY  =  FLOAT  i  MY  )  *  1  C  0  C  ^  FLOAT  (  MO '  *  1  ,  -  FLOAT  ."O  ; 

IF  (  DAY  .  LT  .  3TP.TDA )  GO  TO  1 

I F  (  DAY  .  LE  .  END  DAY )  GO  TO  3  j 

IF(DAY.NE.STRTDA.AMD.LTIMH.GE.STFTH?. '  GO  TO  c 
WRITE  (*,*)  '■  LOST  FRAME  SYNC  -  LOOK  FOR  D'EXT  TIME  FI. 

WRITE  (25,*)  "  LOST  FRAME  SYI.'C  -  LOOK.  FOR  NEXT  'H.'-LE  F( 

OfO  READ  (22,END=5)  SPELOCK 

I F  (  3 PBLOCK  (  1  )  .  NE  .  FL.AG )  GO  TO  5  5 G 
WRITE  (*,*)  ■'  FOUND  IT)" 

WRITE  (25,*)  "  FOUiiD  IT  I" 

GO  TO  1 

3.J  IF  (DAY.  EQ.STRTDA.. AND.  LTI.MH.lt.  STRTHR)  GO  TO  i 
IF  (STRTHR.LT. 0.5/  GO  TO  31 

IF(DAY.NE.STRTCA.AND.LTIMH.GE.STRTHR)  GO  TO  6 
31  VEL=SPBLOCK(2) 

IF(NFRAME.EQ. 1)  IHOLD=64 

NFRAME=0 

GO  TO  11 

4  NEXIT=NEXIT+1 

WR ITE  (  2  5 , 9  9  9  )  DUMMY ,  UR ,  MY ,  MO ,  JO ,  LT  IMH ,  LT  I.MM ,  MS  EC 
)99  FORMAT  (/ //IX,  A12,  ■'  READ  ERROR  AT  OR  NEAR  ECHO  NUMBER 
*F7 .0, 6X, 612) 

WR I TE ( * , 9  9  9 )  DUMMY , UR , MY , MO , JO , LT I MH , LT i;#l , MS  EC 
IF (NEXIT.lt. 1000)  GO  TO  1 

WRITE  (*,1000)  DUMMY, MY, MO, JO, LTIMH,LTIMM, MSEC, DUMMY 
)00  FORMAT( ///IX, A12, "  BAD  FILE  " , 3 12 , IX, 3 12 , A12 ) 

WRITE  (25,1000)  DUMMY , MY, MO, JO, LTIMH , LTIMM, MSEC , DUMMY 
PAUSE  "CR" 

STOP 

SELECT  NEXT  SPP  INPUT  FILE 


5  CONTINUE 

IF(UR.LT.0.6)  GO  TO  8 
IFILE=IFILE4-1 
CALL  IBAD  (IFILE,SKIP) 
IF(IFILE.GT.IEND)  GO  TO  8 
IF  (SKIP.EQ. 1)  GO  TO  5 
CLOSE  (22) 

I1G0=IFILE/100 

110= ( IFILE- 1100 *100) /lO 

I1=IFILE-I100*100-I10*10 

DUM(IO) =CHAR(I100+48) 

DUM(ll) =CHAR(I10+48) 

rUM(12) =CHAR( 11+48) 

UR=1 . 0 
IHOLD=64 

WRITE  (25,1011)  DUMMY 
.1  FORMATC  .ACCESSING  FILE  ", 
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OOP.  non 


M  =  M  r  L 

JR  =  P  R  -►  Ci  IE 

lj::  format  1 13, 3) 

I F ( MOD i M , 3  : 0 )  . ME . 3 i  GO  TO  3 

WRITE  (*,♦!  "  ",M,'‘  ?0ir;T3  PROCE3EED" 

CALL  DateTime 

ISEC4=3600*LHOUR^6C*LMIM-LCEC 
IF( ISEC4 .GT. J3EC)  GO  TO  6 
I3EC3=24*3600 
JSEC  =  20*60 

6  if(npr:mt.eq.yes)  write  (*,io:2)  ■jr,mv,mo,.:o,  ltimh,  l 
*EL3 , EM3 

10  02  format (F7 . 0 , 1 3 , I  3 , 1 3 , 13 , 12 , 2X, 2F6 . 1 , 2F6 . 3 ) 

IF(M.EQ.l)  STRTDA=DAY 

CALCULATE  TIME  WITH  RESPECT  TO  INPUT  PERIODICITY 
CALL  DAYMON  ( MYRDAY , LEAPYR , MO , JO ) 

TMINIT=1440 . 0*FLOAT(MYRDAY-1)  -^60. 3 ‘FLOAT  (  LTIMH)  -FLOA 
*+FLOAT{MSEC) /60.0 
THOUR=TMINIT/60 . 0 
NEWDAY=THOUR/ PERIOD 

T= (THOUR/PERIOD-FLOAT (NEWDAY) ) *TWOPI 
DO  7  J=1,NPMAX 
FJT  =  FLOAT  !J) *T 
SINJ(J)=SIN(FJT) 

COSJ(J) =COS (FJT) 

7  CONTINUE 

ENTER  COUNT  IN  POINT  RATE  MATRIX 

LT  =  LTIMH-STRTHR^-1 
IF(LT.LE.O)  LT=LT+24 
Z0=ZMIN-0 . 01 
Z3=ZMIN+THREE 
DO  13  I=1,NH 

IF(Z.GT.Z0.AND.Z.LE.Z3)  GO  TO  14 

Z0=Z0+THREE 

Z3=Z3+THREE 

13  CONTINUE 

14  MNO( I, LT) =MNO( I, ^T) +1 
RETURN 

C  SPP  DATA  READ  AND  PROCESSED.  FLAG  WINDS  CALCULATION 

C 

8  UR=0.5 

WRITE  (25,1003)  FF 
10  0  3  FORPLRT(Al) 

NOP=NOP+l 

WRITE  (26,1004)  RESULT, SOURCE, NOP 
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c 

c 

r' 


ze:?.o=o  .  c 
OETERM=C . 0 
15  DO  20  J=1,M 
20  :pivot(J)=o 
c 

C  SEARCH  FOR  PIVOT  ELEMENT 

C 

30  DO  550  1=1, N 
40  AMAX=0.0 
45  DO  105  J=1,N 
50  IF(r?IVOT(J) -1)  60,lC5,c: 

60  DO  100  K=1,N 
70  IF(IPIVOT(K) -1)  80,100,74 
80  IF(ABS(AMAX) -ABS(A(J,K)  )  )  85,l-jC,lC: 

35  rROW=J 
90  ICOLUM=K 
95  .AMAX=A(J,K) 

100  CONTINUE 
105  CONTINUE 

110  IP IVOT ( ICOLUM ) = I P IVOT ( ICOLUM )  -  1 
C 

C  INTERCHANGE  ROWS  TO  PUT  PI'.'OT  ELEMEl.’ 

C 

130  IF ( IROW- ICOLUM)  140,260,140 
140  DETERM= -DETERM 
150  DO  200  L=1,N 
160  SWAP=A ( IROW, L) 

170  A ( IROW, L) =A( ICOLUM, L) 

200  A ( ICOLUM, L) =SWAP 
2  60  INDEXd,  1)  =IROW 
270  INDEX(I,2) =ICOLUM 
310  PIVOT(I) =A( ICOLUM, ICOLUM) 

ABSPIV=ABS ( PIVOT ( I ) ) 
IFiABSPIV.GT.ZERO)  GO  TO  320 
DETERM=-13 . 0 
RETURN 

320  DETERM=DETERM+ALOG10 (ABSPIV) 

IF ( DETERM. GT.- 12.0)  GO  TO  330 
RETURN 
C 

C  DIVIDE  PIVOT  ROW  BY  PIVOT  ELEMENT 

C 

330  A (ICOLUM, ICOLUM) =1.0 
340  DO  350  L=1,N 

350  AdCOLUM,  L)  =AdCOLUM,L)  /PIVOTd) 
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0\  o. 


:  0  DO  '71 3  I  = : ,  >i 

3:3  L=Nrl-I 

32 J  IF f INDEX(L, 1) -INDEX !L, 
■£  2 ']  JROW=  INDEX  (  L  ,  1  ) 

340  JCODUM=INDEX(L,2) 

50  DO  705  K=1,N 
50  SWAP=A(K, JROW) 

7  0  AIK,  JROW)  =:A(K,JCOLUM) 
700  AIK, JCOLUM ) =SWAP 
705  CONTINUE 
710  CONTINUE 
740  RETURN 
END 


SUBROUTINE  SDESIG  (NAME, A) 

C 

C  ADDS  DESICNA.TOR  "A"  TO  FILENAME  "NAME” 

C  AS  PREFIX 

C 

CHARACTER*!  A ( 6 ) , NAME ( 40 ) 

C 

DO  1  1=40,7, -1 
NAME(I)=NAME(I-6) 

1  CONTINUE 

2  DO  3  J=1 , 6 
NAME ( J )  =  A  I J ) 

3  CONTINUE 
RETURN 
END 
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C  C  ’'"40  N .  H  R  S  T  ?.  T  ■  S  T  rO 
COMMON /WINDS  '  N,Q,: 
N  :C0 ,  SUM ,  AC  ,  NT  IMS ,  N! 
F, CADD, Z 

COMMON  '  EXTRAS  ■■  IUN: 


c  NO,::?,  rest: 
T,  icadd,‘;go 


c 

CENTIM-1 . 0 
ARCHIT="ARCHIT  " 

CALL  SDESIG  { ARCH IT , CADD ) 

OPEN  ( 14  ,  FILE^ARCHIT,  FORM^  "CN’FORMG^TTED''  ,■ 
C 

N0P=N0P+1 

WRITE  (26,998)  FF , RESULT , SOURCE , NOP 
9  9  8  FORMJ.T  ( A1  /  7  2A1 , 8A1 , 2  6X ,  "  PAGE "  ,  I  3  /  i 
C 

EAST -WEST  WIND  COMPONENT,  HOUR  3V  HOUR 


WRITE (26 , 597 ) MIN, MAX 

597  FORMAT ( IX, 52HEAST-WEST  COMPONENTS  OF  THE  MEAN 
*,  HOUR  BY  HOUR, 

1/1X,34HAS  DETERMINED  FOR  THE  HEIGHT  RANGE, 15, 

2/) 

•  VJRITE(26, 600)NTIME 


600 

FORMAT  (1X,6HHEIGHT,24I5''1X) 

DO  128  J=1,NP 

128 

NANEW(J) =NA( J) 

NFNEW^NP 

KEND=0 

• 

NAOE=NAO-^  1 

NBOE=NBO+l 

NCOE=NCO+l 

NSIGN=-1 

105 

KA=KEND 

DO  307  KZ^MIN,MAX 

UO=Q  .  0 

• 

DO  303  LT=1,24 

• 

3  03 

U ( LT ) =  0  .  0 

Z=MAX+MIN-KZ 

NZ  =  Z 

S= (2 . 0*Z-ZMAX-ZMIN) / (ZMAX-ZMIN) 

DO  304  K=l,NAOE 

KUA=K+KA 

3  04 

UO=UO+AC (KUA) *S** (K-1) 
UO=UO*CENTIM 

IF(NPNEW)  310,310,308 
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K- 1 ! *C0£ I  FLOAT 


C 

C 

C 


C 

C 

c 


=  K  KcL  A.-^, . 

a:  ;  T  !  IT  I =0  !  IT ;  -AC ' FT ■  'T 

K  START =fe:;t 
MAFMD  =  I'ACEWi  0)  -  I 
K  EMD  =  K  ST  ART  V 'AETID 
SLT  =  S*  LT 

DO  312  k=i,mae>:d 

312  U ( IT) =U ( IT) -AC (KT) *S 

"  M  * '  'O 

IF(A33(U(:T) ) -539.2)  300,300, 111 

309  CdT)  =SrGN(999.  0,0(1?)  ) 

3  06  CONTI.NUE 

GO  TO  313 

310  KEMD=KA  +  N’AOE 
U(l) =UO 

IF  (ABS  (U  (  1)  )  -  399  .  ;  )  TOI’ ,  1  0 ■■ ,  3  1 1 

311  U(1)=SIGN(999.0,U!1) ) 

107  DO  108  LT=2,24 

108  U(LT)=U(1) 

313  WRITE  (14)  :jZ,U,:j(l) 

307  WRITE (26, 888)  NZ,U 
888  FORMAT (IX, 14, 3X,24F5.0) 

IF(NSIGM)  129,131,133 

NORTH -SOUTH  WIND  COMPONENTS,  HOUR  BY  HOUR. 

12  9  N.AOE^NBOE 
NPNEW=NQ 
DO  130  J=1,NQ 
130  NANEW(J) =N3(U) 

NSIGN=0 

NOP=NOP+l 

WRITE  (26,998)  FF ,  RESULT .  30U.=CE ,  NOP 
WRITE (26, 598) MIN, MAX 

598  FORMAT ( IX, 54 HNORTH- SOUTH  COMPONENTS  OF  THE 
*  HOUR  BY  HOUR. 

1/1X,34HAS  DETERMINED  FOR  THE  HEIGHT  R.-iUGE, 

2  / ) 

WRITE  (26, 600)  NTI.ME 
GO  TO  105 

VERTICAL  WIND  COMPONENTS,  HOUR  BY  HOUR. 


MEAN 


fl  , 


NAOE=NCOE 
CENTIM=10  0  .  0 
NPNEW=NP. 
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'■:c,  :;ai 

,  z ,  A  ( . 


AIMEIISIOrj  Q  (  Z  ?  ;  ,  2C  2  '  ,  MA  !  1 T  >  ,  Mr  :  1 1  '  ,  MC  {  \  , 

IMTIME  (24  1  ,  AC{2C0)  ,  31  {12  i  ,COl  ,  AM.  1  :  .  ,  22  :  : : :  , 
23:G3C  (  iO  )  ,  SIGCOS  (  12  )  ,  SIGPH  i  IZ  ^  ,  GIGAA:?  !  a:  ;  ,  Er.PH 
3?TEM(4) 

CHARACTER*!  RESULT(72)  ,  SOZ’PCE  >  3  !  ,  EB ,  FF ,  CADD  (  3  ) 
CHARACTER*40  TIDE , ERROR , ATIDE 

COMMON/ WINDS /  N , Q , NOP , ZMIM , MIN , 2MAX,MAX, MA, ME, 
1 AC , NT IME , NF , MQ , NR , RESULT , SOURCE , FERIOD, FF ,  CADD 
COMMON,  EXTRAS/  lUNIT,  ICADD,  NGO,  STF.TDA,  EN'DDAY,  L 
* FINO  (20,24)  ,  NF : LE ,  LENGTH ,  NEG ,  NFMA.X ,  EERO ,  NFR INT 

CENTIM=1 . 0 
TIDE="TIDE  " 

CALL  SDESIG  (TIDE, CADD) 

OPEN  (15,  FILE  =  TIDE,  FORM='‘yMFORMATTED"  ) 

ERROR=" ERROR  " 

CALL  SDESIG  (ERROR, CADD) 

OPEN  ( 16 , FILE=ERROR, FORM= "UNFORMATTED" ) 

ATIDE= "ATIDE  " 

CALL  SDESIG  (ATIDE, CADD) 

OPEN  (17,FILE=ATIDE, FORM= " FORMATTED" ) 


FB="  " 

NOP=NOP+l 

WRITE (2 6, 998)  FF , RESULT , SOURCE, NOP 
WRITE (17,998)  FB, RESULT, SOURCE, NOP 
FORMAT (A1/72A1, 8A1, 2 6X, "PAGE" , 13/ ) 

NAOE=NAO+l 
NBOE=NBO+l 
NCOE=NCO+l 
KEND=0 
DO  86  J=l,4 

PTEM ( J) =PERIOD/FLOAT ( J) 

CONTINUE 

NSIGN=-1 

WRITE(26, 597)  MIN, MAX 
WRITE(17, 597)  MIN, MAX 

FOPJ4AT(lX58H  EAST-WEST  COMPONENTS  OF  THE  MEAN  WIND,  .AMPLITUDE  .AND 
IPHASE, /IX, 35H  AS  DETERMINED  FOR  THE  HEIGHT  RANGE, 15, 6H  KM  TO, 15, 
24H  KM. // ) 

IF(NP)  89,89,88 
WRITE (26, 87) 

WRITE (17, 87) 

FORMAT (IX, 18 HHEIGHT  MEAN  ERROR/ IX) 

GO  TO  105 

GOTO  (99, 99, 101, 103) ,NP 
WRITE (26, 100)  (PTEM(J) , J=l,2) 

WRITE(17, 100)  (PTEM(J) , J=l,2) 

FORMAT (22X, F6. 1, 15H  HOUR  COMPONENT, 3X, F9 . 1 , 15H  HOUR  COMPONEN"/  !X, 
17  5HHEIGHT  MEAN  ERROR  AMP  ERROR  PHASE  ERROR  .AMP  EFFOR  ? 
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106 


107 


108 


109 


110 


GO  TO  105 

WRITE  !  26 , 1 04 )  ( ?TEM ( J '  , 0  =  1 , 4 > 

WRITE ( 17 , 104 )  ( FTEM'J ) , J=1 , 4 i 

FORMAT (22X, E6 . 1 , 15H  HCTR  COMFONEWT, OX, 
1F9.0  ,  15H  HOT?.  CGMFONEKT ,  3X ,  F9  .  1 ,  1 5 H  HO 
2  2  9HHE:GHT  MEAiM  ERROR  AM?  ERROR 
OHASE  ERROR  AM?  ERROR  PHASE  ERRC 
4,/ IX) 

KA=KEND 

DO  128  KZ=MIN,MAX 
UO=0 . 0 

Z=MAX+MIN-KZ 

N2=Z 

S= (2 . 0*Z-ZMAX-ZMIN) / ( ZMAX-ZMIN) *  1 . OE-G 

DO  106  K=l,NAOE 

KUA=K+KA 

UO=UO-fAC(KUA)  *S**  (K-1) 

UO=UO*CENTIM 
SIGUO=0 . 0 
DO  107  K=l,NAOE 
DO  107  L=l,NAOE 
KS=K+KA 
LS=L+KA 

SIGUO=SrGUO+S**  (K-l)  *-S**  (L-1)  *A(KS,  LS) 

AS IGUO=ABS ( S IGUO ) +  0 . 0 1 

SIGN=SIGUO/ASIGUO 

EO=SIGN*SQRT (ASIGUO) *CENTIM 

IF(NP)  126,126,108 

KEND=KA+NAOE 

NUMNA=0 

DO  109  J=:1,NP 

SI ( J) =0 . 0 

CO(J)=0.0 

SIGSIN( J) =0 . 0 

SIGSC ( J) =0  .  0 

SIGCOS { J) =0 . 0 

^JUMNA=NUM^JA+MA  ( J ) 

CONTINUE 
DO  121  J=1,NP 
NUSIN=NP+NUMNA 
KSTART=KEND 
NAEND=NA(J) +1 
KEND=KSTART+NAEND 
DO  110  K=1,NAEND 
KS=K+KSTART 

SI ( J) =SI ( J) +AC (KS) *S** (K-l) 

KC=KS+NUSIN 

CO(J) =CO(J) +AC (KC) *S** (K-l) 

SINSQJ=SI (J) **2 
COSSQJ=CO(J) **2 


♦SUM 
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S  I’MSQJ  =  2 INSQJ  *  C0S3QJ 
Ai:,Ji  =3Qr.T  iSUMSQJ)  'CEI^iT 


115 


11b 


113 


119 

121 

122 

123 

124 

125 

126 


28 

128 

129 


IF'COiJ);  114,111,11; 
?H  i  J)  =FJ,.  4  .  0 


GO  TO  116 
?H(J)  =  F.:*0  .I; 

GO  TO  116 

?H  (J)  =FJ*0  .  5*  ;FJ,'6 .23316  )  ‘ATAIJISI  iJ)  COiG)  - 
GO  TO  11b 

PH{J)  =  (FJ,  5 .28312)  ‘.AT.AMiSl  ( J)  'COU)  ) 

IF ( PH ( J) )  117,118,118 
PH ( J) =FJ+PH ( J) 

DO  119  K=1,NAEND 
DO  119  L=1,N.AEND 
KS  =  K-i-KST.ART 
LS=L+KSTART 
KC-i<.-'-^G'TSIN 
LC=LS+MUSIN 

SIGSIN(J) =SIGSINf J) +S** (K-1) *S** (L-1) *A(KS, LS) 

SIGSC{J) =SIGSC(J) (K-1) *S** (L-1) *A(KS,LC) 

SIGCOS(J) =SIGCOS (J) +S** (K-1) "S** (L-1) *A(KC,LC) 

PROD=2.0*SI(J) *CO(J) *SIGSC(J) 

SIGPH(J)  =  (COSSQJ*SIGSIN(J) +SINSQJ*SIGCOS ( J ) -PROD) *  SIM/ SVMSQJ * 
SIGAMP(J) = (SINSQJ*SIGSIN(G) +COSSQJ*SIGCOS ( J) -PROD) ‘SUM/SUM30J 
ERPH(J) =SQRT (SIGPH ( J) )*FJ/6. 23313 
ERAMP(J)=SQRT(SIGAMP(J) ) *CENTIM 
KEND=KEND+NUSIN 
GOTO  (122, 122, 124, 125) ,NP 

WRITE (26, 123)  NZ,UO,EO, (AU( J) , ERAMP( J) , PH(J) , ERPK( J) , J=l, 
WRITE(17, 123)  NZ,UO,EO, (AU(J) ,ERAMP(J) ,PH(J) ,ERPH(J) ,J=1, 
FORMAT ( IX, 14 , 2X, F6 . 0 , 2X, F6 . 0 , 4 ( IX, 2F6 . 0 , 2F7 . 1 ) ) 

WRITE  (15)  UO, (AU(J) ,PH(J) , J=l,2) 

WRITE  (16)  EO,  (ERAiMP(J)  ,ERPH(J)  ,o'=l,2) 

GO  TO  28 

WRITE (26, 123)  NZ,UO, EO, (AU( J) , ERAMP(J ) , PH( J) , ERPK ( J) , J=1 , 3 ) 
WRITE (17, 123)  NZ,UO,EO, (AU(J) ,ERAMP(J) ,PH(J) ,ERPH(J) , J=l, 3) 
WRITE  (15)  UO, (AU(J) ,PH(J) ,J=1,3) 

WRITE  (16)  EO, (ERAMP(J) ,ERPH(J) , J=l, 3) 

GO  TO  28 

WRITE(26, 123)  NZ,UO,EO, (AU(J) ,ERAMP(J) ,FH(J) ,ERPH(J) ,J=1,4) 
WRITE(17, 123)  NZ,UO,EO,  (AU(J)  ,EPG>Jy!P(J)  ,PH(J)  ,ERPH(J)  ,J=1,4) 
WRITE  (15)  UO, (AU(J) ,PH(J) ,J=1,4) 

WRITE  (16)  EO, (ERAMP(J) ,ERPH(J) , J=l,4) 

GO  TO  28 

WRITE(26, 123)  NZ,UO,EO 
WRITE (17, 123)  NZ,UO,EO 
WRITE  (15)  UO 
WRITE  (16)  EO 
KEND^KA+NAOE 
CONTINUE 
CONTINUE 

IF(NSIGN)  129,131,133 
NAOE=NBOE 
NP=NQ 

DO  130  J=1,NQ 
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r\J  c] 


»  / 


2 "  KM . "  I 
GO  TO  98 

IFiNEG.EQ. -1)  GO  TO  133 

MAOE=NCOE 

MF  =  NR 

DO  132  J=1,NR 
NA  ( J )  =NC  { J ) 

MSIGN=1 

MOP=NOP+l 

WRITE ( 2  6 , 9  9  3 )  FF ,  RESULT , SOURCE , NOP 
WPITE(26, 599)  MIN, MAX 
WRITE ( 17 , 99S )  FF,  RESULT, SOURCE, NOP 
WRITE(17,  599)  MIN,  FLAX 

FORMAT (IX,"  VERTICAL  COMPONENTS  OF  THE  MEAN  WIND,  AMPLITUDE 
1  PHASE" /IX,"  AS  DETERMINED  FOR  THE  HEIGHT  RANGE", 15, cH  KM  TO, 
2"  KM."/"  ’***  .NOTE  THAT  '-’PHTTCAL  WINDS  ARE  IN  CENTIMETERS 

3  PER  SECOND!  ****"//) 

CENTIM=100.0 
GO  TO  98 
WRITE(26,85)  FF 
WRITE (17, 35)  FF 
FORM.AT  (Al) 

CLOSE  (17) 

RETURN 

END 
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CHARACTER* 1  TAB, FF, REFMT : CSC i  , FECTIT ' “C  > 
CHARACTER *4  CADE 
CKAP.ACTER*40  INFILE,  CTTFIIE 
COMMON /WINDS/  N,  Q  (EGO  ,  20  0  )  ,NO?,  ZMIIi,  MIN, 
* NA  (  1 0  )  ,  NB  (  1 0  )  ,  NC  ( 1 0  )  ,  MAO ,  I:B0  ,  NCO ,  SUM ,  AC  i 
*M?, NQ, NR, RESULT, SOURCE, PERIOD, FE,CADD, Z 
COMMON/ HEIGHTS /NOZ 
DATA  LOOP/0/ 

C 

C  OPEN  I/O  FILES 

C 

OPEN(15, FILE=INFILE, FORM=”UNFORMATTED" ) 
CALL  SDESIG  (OUTFILE, CADD) 

OPEN  ( 16  ,  FILE=OUTFILE,  FOP.M=  "  FORMATTED" ) 

IF(LOOP.EQ.l)  GO  TO  1 

LOOP=l 

ISTOP=0 

TAB=CHAR(9) 

NCHAR=232 
1  DO  8  1=1, NOZ, 2 

READ  (15)  (REFMT ( IC) , IC=.,NCHAR; 

NTOP=NCKAR 

IF  =  6 

4  IF=IF+1 

IFdF.EQ.  ISTOP)  GO  TO  7 

5  IF(REFMT{IF) .NE.TAB)  GO  TO  4 
KTOP=NTOP-IF 

DO  6  KK=l,KTOP 

REFMT ( IF- 1+KK) =REFMT ( IF+KK) 

6  CONTINUE 
NTOP=NTOP-l 
ISTOP=NTOP-l 
GO  TO  5 

7  LCHAR=NTOP-l 

WRITE  (16,100)  ( REFMT ( IC ), IC=3,LCHAR) 

100  FORMAT(250A1) 

8  CONTINUE 

CLOSE  (15, STATUS=" DELETE "  ) 

CLOSE  (16) 

RETURN 

END 
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The  IDl  wind  analysis  program  IDIWIND.f 

This  program  is  a  variant  of  Wind,  for,  ann  rears  toe 
scattering  point  parameter  files  SPP  -  GR  XXX  files  from  t.oe 
hard  drive.  Output  profiles  of  zonal,  meridional  and  vertical 
wi.nds  is  located  in  folder  orjTFILE  as  file  YYYYYYYY .  M.eW’, 
where  YYYYYY'YYYY  is  two  digit  (leading  zero)  month,  dai' ,  Incur 
and  minute  of  the  midpoint  of  the  selected  interval,  whose 
duration  is  entered  (in  minutes)  at  progra.m  pro.m.pt  . 

INPUT 


Reads  file  SET. TIME,  which  is  simply  a  listing  of  all  the 
interval  enter  point  times  to  be  reduced,  tormatted  as 
follows 

8905031215 

8905031322 


0000000000  !  EOF  FLAG 

Requests  length  of  interval  (in  minutes) 

Requests  selection  of  polarization  of  received  returns 

[Winds  will  be  contaminated  by  using  other  than  the 
transmitted  polarization  -  O  (ordinary)  in  the  case  of  the 
AIDA  data.  L  (linear)  has  been  identified,  in  the  AIDA  data, 
as  RF  interference  from  an  harmonic  of  a  broadcast  band  AM 
signal.  The  origin  of  X  (extraordinary)  has  not  been 
determined] 

OUTPUT 

In  addition  to  data  file  XXXXXXXX .  MAW ,  a  status  file 
WIND.TXT  contains  run  diagnostics. 
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o  o  n  o  o  f:)  o  o  n  o  r)  o  o  o  o  o  o  o  o  o  o  o  o  o  i) 


***** 


********* 


MAC  VE?.,’  ;  “^i  1  .  L  r 

THIC  EROGRAM  a  I EL  CALC! 
PROFILES  IM  1-KH  STEPS 
PC  I  NT  PARA.METEr.  FILES, 

CURRENTLY  SET  OF  FOR  -■ 
DIMENSION  OF  SFPZdH,: 
R.ANC-ES  . 

THE  SCATTERING- PC' 

1.  ALTITUDE  !KA1)  . 

2.  RADIAL  VELOCITY  'M  SEC) 
;  .  ZENITH  .ANGLE  IN  EA3T-WE 


smoothing,  ) 


.AND 


PARAMETERS 


MiTi'U  '--UC-S 


MEE  IDO  .AN  !  DEG?.: 


4  . 

5  . 

6  . 


lENITH  ANGLE  IN  NCRTH-30UTH  MERIDIAN  (DEGREES 


(JUST  CHANGE  THE  SOURCE; 


VOLT.AGE  .AMPLITUDE  ON  #1  DIPOLES. 

PH.ASE  OF  #1  DIPOLES  (DEGREES). 

7.  VOLTAGE  AMPLITUDE  ON  #2  DIDCLDS. 

8.  PK.ASE  OF  #2  DIPOLES  (DEGREES!. 

9.  ERROR  IN  3 

10.  ERROR  IN  4 

EXPLANATION  OF  E.ASILY-REPROGR.AMMED  P.AR.AMETERS 
CODE  VALUE  GIVEN  BELOW: 

’VMAX  IS  THE  LARGEST  ALLOWED  HORIZONTAL  VELOCITY.  WE  TEST  E.ACK  FOI 
AGAINST  '/MAX  BY  PROJECTING  ITS  RADIAL  VELOCITY  INTO  THE  HORIZONTAL 
PLANE,  AND  REJECT  IT  IF  IT'S  BIGGER  THAN  mAX. 

THMAX  IS  THE  LARGEST  ACCEPTABLE  RACIAL  ZENITH  ANGLE. 

THMIN  IS  THE  SMALLEST  ACCEPTABLE  RADIAL  ZENITH  AJJGLE. 

MINH,  MINV  ARE  THE  MINIMUM  NUMBER  OF  POINTS.  IF  THERE  .ARE  NOT 
SUFFICIENT  POINTS,  TH.AT  .ALTITUDE  IS  SKIPPED. 

NSIGMA  IS  THE  MAXIMUM  NUMBER  OF  3T.ANDARD  DEVI.ATIONS  FROM  THE  FIT 
INDIVIDUAL  POINT  CAN  LIE  WITHOUT  BEING  REJECTED  FROM  THE  VELOCITY 
CALCULATION. 

ZMIN  IS  THE  BOTTOM  ALTITUDE  FOR  WHICH  WINDS  ARE  TO  BE  C.ALCULATED 
ZMAX  IS  THE  TOP  ALTITUDE  FOR  WHICH  WINDS  ARE  TO  BE  CALCULATED. 
WIND  CALLS  INNAME,  OUTNAME,  WFV,  WFH,  PHFIT  AND  SORT. 

REAL*4  PI,'/MAX,THMAXV,U(50) ,V(50) ,W{50) ,TRP(50)  ,SUCKS(8)  , 

1  LINE(IO) ,RMSDVR(50) ,COSL(2300) ,COSM(2300) ,COSN(2300) , 

2  DVR(2300) , SLOPE, INTERCEPT, VRAD ( 17 ) 

INTEGER*4  REJ ( 4 ) , IH, PARAMETER, TESTFLAG, POINT,  MPROFS  ,  NHITE3  , 

1  NPOINTS(50)  ,  INTERVAL, BIGTIME, NPV,NPVO,FITFL.AG, MISS, NB.AD 

2  YEAR , MONTH , DAY , HOUR , MINUTE , MINH , MINV , MSEC , lO , NGO , NF I LE , 

3  NUMRADd?) ,MY,MO, JO, LTIMH, LTIMM, INTHALF , NOWSTART , NOWEND 
CHARACTER* 40  INFILE , OUTF I LE 

CHARACTER*27  INPATH 
CHARACTER* 19  OUTPATH 
CHARACTER *6  STATE 
CHARACTER*!  ANSI , POLAR 

COMMON  /WINDl/  SPP ( 2300 , 7 ) , SPPZ ( 15 , 2300 , 7 ) 

COMMON  /WIND2/  Z , U, V, W, TRP, REJ, LINE, WIDTH ( 50 ) , IWT/2300) , 

4  RMSDVR(50)  ,  COSL ,  COSM,  COSN,  DVR,  NUMR.AD,  VRAD 
COMMON  /WIND3/  PI ,  VMAX,  THMAXH,  THMINH,  THMAXV,  THMINV,  MINH  ,  Mlir,' , 

1  NSIGMA, TESTFLAG, IH,NPOINTS, INTERVAL, INFILE , OUTFILE , 

2  INPATH , OUTPATH , NPH , NPV, NPVO , 

3  SLOPE, INTERCEPT, FITFLAG 

COMMON  /SPPFILE/  IFILE ,  YE.AR ,  MONTH ,  DAY ,  HOUR ,  MURoTE 


n  :  0  0  2  - 


CCOO jC34 


COOl 
c  G  0 ; 

.ANOOOC 
C  0  0  ^ 

ooo: 

,-'1 A 


i;  C  j 
000 
000 
000 
000 
0  'j  0 

coo 
0  0  0 
00  0 
0  00 
JOO 

n 

G’  v'  J 

0  C  0 


r,  -  r, 


000 
M  n  0 


00040 
0  lO  0  4  1 
0G042 
0C043 
0  0044 
00045 
0  0  04  6 
00047 
0CO48 
G0049 
0CC50 
Q  0  0  5  1 
0  0  0  52 
000  5  3 
00054 

>  0  0  'D 

3005b 
"  O'  0  7 


■J b  b 

0  (j  0  59 
000  60 
00061 
'b  '' 
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o  n  o 


ft 


«'*»«r*tlr**4’-*'**'*ik**'*i^#*it’**#*A’*»#«***'*****«*«ir**ik**viir*««*«*«*«ir«««««***««*«« 

*  'Gt-IMUNICATE  WITH  'JSEP. 

i^»]ir'*ik**'*<t*ir*****'**'***'*'*«***'*i(***'*«ir'*«-«*i(i*«i»'**«**ir«««i»ir'***«iir««ir««'****«»«*  ' 

2CC0I  WRITE  (*,*l  '  HAVE  YOU  UPDATED  rlLE  GET. TIME?  V  OF,  M' 

READ  (*,'tA)')  .ANSI 

IF  {.ANSI  .ME.  'Y')  THEM  ? 

WRITE  (*,*)  '  E-X.TTING  SO  THAT  SET.TI.ME  C.AN  3E  U.-D.ATED' 

P.AUSE  'CR  TO  EXIT' 

STOP 
END  IF 

OPEN  ST.ATS  FILE  'WIND.T.XT'  } 


665  OPEN  (15,FILE='WIHD.TXT'  ,  EP,P.  =  666 , 3T.ATUS=  "NEW  ,  IOSTAT=IO, 

1 FORM= “ FORMATTED " ) 

666  IF  (lO.NE.O)  THE.M 

WRITE  (*,*)  'A  WIND.TXT  FILE  .ALRE.ADY  EXISTS,' 

WRITE  (*,*)  'DO  YOU  WISH  TO  WRITE  OVER  IT?  Y  CR  N" 

READ  (*,*)  .ANSI 
IF  {.ANSI  .EQ.  '  Y' )  THEN 

OPEN  (15,FILE='WIMD.TXT'  ,EP.R  =  666,  IOST.AT=  lO,  FC.RM=  “  FORILATTED"  i 
CLOSE  (15, STATUS =' DELETE ' ) 

GO  TO  665 
ELSE 
NERR=0 
GO  TO  90909 
END  IF 
END  IF 

667  'WRITE  (*,*)  ’  ENTER  LENGTH  OF  INTERVAL  (MINUTES)' 

READ  (* ,*)  INTERVAL 

I.MTHALF  =  INTERVAL/ 2 

'a'dITE  (*,■"!  "  SELECT  POLARIZATION  -  ENTER  C,  X,  L  CP  ALL" 

READ  { * , *  I  POLAR 

INPATH  =  'MAXTOR600: INFILES :SPP  -  GR  ' 

CUTPATH  =  'MAXTOR600;OUTFILES: ’ 

WRITE  (*,*)  '  ENTER  FIRST  SPP  -  GR  FILE  NUMBER' 

668  READ  ( * , * )  NFILE 
LOOP=0 

C 

C  OPEN  'MIDPOIN  TIME  OF  EACH  DATA  INTERVAL  FILE'  =  SET. TIME 

C 

OPEN  ( 17, FILE="SET.TIME" , FOPJ^= " FORMATTED " ) 

C 

669  IFILE=NFILE-1 
C 

C  PROGRAM  ACCEPTS  SPP  DATA  OVER  3KM  HEIGHT  RANGE  FOR  E.ACH  ALTITUDE 

C  AND  LOOPS  THREE  TIMES  THROUGH  SPP  DATA  TO  PRODUCE  OUTPUT  AT  IF'-I 


?'  9  4 


I C  0  0 '?  ■  0  P 
00000109 
GOOOOIIO 
00000111 
00000112 
00000113 

'  r>  n  r\  P  ■ 

0  0  0  00115 

OCOOOllS 

00000115 

00000120 

CQ000121 

00000123 

000CG124 

00000125 

0  0  O'  0  0  1 2  A 
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• 

he::;ht  =  .  ex::;,  ■  :::::  . 

L  r  -i." 

Z7  THE!: 

-  - 

• 

-’^2.  “  5!  =  ~  EV.'  “ 

,  1  ^ 

ETIE  Z~ 

- 

M  ■’■  -s  -. 

• 

-  11'.^ 

ET  JE  Z E 

.  ; : 

REwi:;r 

!  »  5 

-'MT-j  - 

• 

END  IF 

MH ITES  =  f  EMru<  -  Zy.Zll  <  ]  .7  .  Z 

.  , 

NGO  =  0 

_  t  ' 

GC  TC  203 

-  ■ 

*  RETURN  HERE  FOR  NEW  INPUT  FILE 

-  .  - 

****★*•**♦•**♦*★**★■*»*«**•*******»*•••*•*»»»•**»••••♦*•**♦**•*****«*•** 

•  «  • 

• 

20203  NGO=l 

•  “  '» 

203  CALL  INNAME 

WRITE  (*,*'  'INFILE  -  '.INFILE 

1  - 

NERP.  =  1 

. -  “ 

OPEN  (13, ERR  =  0090R, FILE= ir;F ILE, OTATTO= '  'LL  '  ,  lOSTAT  ^ 10 , 

■  ■: - 

'FCPJ^=  '  UMFOPJ'IA.TTEL  '  ) 

1  ■'  "* 

WRITE  (15, '(Ai’;  INFILE 

.  '• 

• 

2010  READ  ( 18, ERR  =  9000?, IOSTAT=IO, ENL  =  2 :2C3  ■ 2  INE ■ FARAM.ETE? •  , 

...  -  1 

*PARAMETEP.  =  1 ,  10  ) 

.  1 _ 

IF  (LINE(l)  .GT.  -3>?C.O)  GO  TC  lOlO 

. .  r ' .  I  '  ■ 

WRITE  (*,100)  (LiNE(KK;  ,KK=:,  :::> 

1 4 

100  FORMAT  (10F3.0) 

WRITE  (15,100)  (LINEIKK)  ,;-'K  =  l,  10) 

u .. : : :  i-f- 

MY=LINE(2 ) 

^ 

• 

MO=LINE(3 ) 

c : ;  1  -  - 

JO=LINE(4) 

: :  C' : : :  r  - 

LTIMH=LINE(5) 

••  '• 

LTIMM=LINE(6) 

'  i 

MSEC=LINE (7 ) 

t  -  - 

NOWTIME^  LTIMM+LTIMH*60•^JO*24*60+MO*30*24*60 

.* 1  ”  '1 

REWIND  (13) 

.  j 

• 

IF  (NGO.EQ.l)  GO  TO  20103 

4r'*’'#'****-***'*’*«-*«'*'*-*-*'*'*«'*'*‘*«'**«*’*'*'**'*-«r*'*****'**«'*«**'*««i^«*«**’'****4’****’'«r* 

*  RETURN  TO  HERE  FOR  NEW  OUTPUT  FILE 

V  4. 

20101  NERR=2 

0  u  r* 

READ  (17,101,END=90910)  YEAR, MONTH , DAY , HOUR, MI  tFJTE 

j  C  ?  0 1  o  ^ 

101  FORMAT  (512) 

ZCZZZl^Z 

A 

IF  (MONTH. EQ.O)  GO  TO  90910 

ZCZZjIzZ 

w 

NPROFS=0 

BIGTIME  =  MINUTE+HOUR*60+DAY*24*60+MCNTH*30*24*60 

Z,  C  C  ?  1 '?  4 

NOWSTAP.T  =  BIGTIME-  INTHALF 

:■  c  1  5 

IF  (NGO.EQ. 1)  GO  TO  670 

:oc  :j136 

IF  ( NOWTIME. GT.NCWSTART)  THEN 

j  3 :  C'  1 8 

WRITE  (*,*)  "  BAD  CHOICE  OF  SPP  INPUT  FILE;  RE-ENTER  3PF  INPUT 

ooc  ;gis5 

♦FILENAME" 

C20CU199 

• 

CLOSE  (18) 

GO  TO  668 

• 
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► 

1 

•  o:.  -  •  ■ -0- ■_  ■  ■  ■  "  '  -0-  ■  TO  ::  o:  ;  :  ;  ;  ; 

.  ■- 

» 

:;:  ::::  ; . 

■ 

• 

-  '  - 

■'-7;T::;rE 

^  "  1  -  _ 

■,vF:rE 

-  ■  ■  ;  j 

=■  -  z ^ 

• 

1  ix,  '  Ai-T  y.  Tr?  !ir  I  i.'ik  -a-.t-i 

-  1 

_  ‘  SLC?E  IMTER'ETT’^ 

..  1  ■' 

;jE?.p.=4 

-  -  * 

READ  ;  1  3  ,  ER?.  =  :R1‘V  .  1  :3TAT=  1  1 .  Et'S-^  :  LZ::E  F  AFA-METE.-  :  , 

*?A?,.^METEF.=: , :: ) 

IF  (EINEil*  .07,  -0?:.:'  70  TO  o::.; 

: . :  2  _ : 

• 

*  3  c 

T7RN  TC  HEF.E  FOR  NEW  PFCFILE  . 

i 

***** 

*********«***•«****«***»«***««**«******••***«*«•**•••••■•••*« 

2  2  113 

my=li:;e(2! 

mo=i::;e(  3  > 

... 

jo=l:me ( 4 ) 

LTIMH=LIME(S) 

i7:mm=2:ne(6 1 

.  .  . 

• 

M3EC=:Li;:E:7i 

. 1 

M0W7 1  M.E  =  LT I  MM  ^  LT  :  MH  *  6  :  *  JO  *  2  4  ♦  0  ■;  ♦  MC  *  3  :  *  2  4  *  0  ■: 

!  .  1.  .■ .. 

IF  (NCW7IME.  2T.NCW3T.AF.T)  GO  70  201  03 

.1  ;  .’ 

I F  ( MOWTIME . 07 . MGWEMD I  THEM 

.,■.2:4 

BACKS  PA.CE  (13) 

GO  TC  20204 

.  .  ?  2  j  *: 

EMD  IF 

A 

MPR0F3=MPP.0FS>1 

.  2  1  _  2  : 

MERR=5 

‘  '  ‘  3 

READ  (  18,  EFP,  =  90909,  IG3T.AT  =  IC,  EMD  =  2'203  '  (  MIME  ■  F.AF.-IIETEF  ■  , 

-  -  - ■  *..  4  . 

♦P.AR.AI^ETER=:1  ,  10) 

_  -t ... 

IF  (MIMEd)  .1.7.  -3^90.;!  7HEM 

„  -  .  .  w  _ 

MPF.CF3  =  NPF.0FS-  1 

.  .'■-.■..-24: 

GO  TO  20133 

j : :  2  4  4 

• 

0 

EMD  IF 

' : ;:o242 

‘4  ^ 

TEST  THE  POINT  FOR:  ALTITMDE 

.  0  .  .  .;  2  4 

C 

.  -  j 4  “ 

20202 

IF  (LIMEIl)  .LT.  ZMIM)  THEN 

: : : ;  2  4  - 

MERR  =  6 

■  ■  .0  '  “  c 

READ  ( 18  ,  EP,P.  =  90909  ,  ICSTAT=IO,  END=202;3  )  '  MIM'E  ■  F.ARA2ID7EF  :■  , 

- '''Cl 

*PARAMETER=1 , 10) 

_■ ')  3  2  ~  2  5  2 

• 

IF  (LINE(l)  .LT.  -990.0)  GO  TO  20133 

..  'j  2  '3  0  2  13 

GO  TO  20202 

M  :■ :  ■: :  2 1 4 

EMD  IF 

• 
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I 


1  r  '.-^20' - it  I  ^  , 

PEJ  :  3  ^PEJi 3 i 


r  ET ERMi >:e  fceap  :  eat  i 

A:.’EEE  =  EINE  '  ■?  I  -EE.'JE  ■  i  ' 

IF  (  POLAR.  EO  .  ".A”  '  GOTO  i  3EC  1 
:  F  (  POLAR. .  EQ  .  L  ”  )  THEM 
IF  lABSiAJIGLE) .LT.45.0)  GOTO  IIECI 

IF  I  ABS  ( .iOlGLE )  .  GT  .  I  3  3 . 0  .  AE4D  .  A5S  t  AJ.’GLE )  .  LT  .  2 E  5  .  j  !  GC 
IF  f  ABS  ( .ANGLE  I  .  GT .  3  1 5 . 0  .  AJ-JD  .  A3S  ( .-OIGLE )  .  LT .  3  3 C  .  3  )  GC  T' 
GO  TO  10200 
END  IF 

IF  (FOL.AR.EQ.  "X”  )  THEN 

IF  !. ANGLE. GT. -135.0.. AND.. ANGLE. LT. -45.0'  GCTC  1020: 

IF  {.A^;GLE.GT.  225 .0.. AND. . ANGLE.lt.  315 .0)  GOTO  10201 
GO  TO  1C200 
END  IF 

I F  ( POLAR . EQ . " O “ )  then 

IF  ;  ANGLE.  GT  .  45 . 0  ..AND.. ANGLE.lt.  135 . 0  )  GOTO  102Q1 
IF  i.y-IGLE.GT. -315 . 0..AND..ANGLE.LT. -225 .0)  GOTO  102C 

TESTFL.AG  =  0 
.REJ(4)  =REJ(4  )  -1 
END  IF 

CHECK  FOR  TOO  MANY  PCI.NT3 


100033:2 

0G0003C4 

i3  0  0  0  0  3  0  6 
0000C307 
0000C308 
O'  0  0  0  0  3  0  9 
'0 1 G  G  0  3  I  0 
00000311 
00000312 
0C000313 
00000314 
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'  L I^^E  ^  I  / 


:f  ;  ih.gt .^^hIEss)  gu  tc 

E  =  GM I M 1  .  5*3  .  0  '  '  FLOAT  i  I H -  1  '  ' 

IF  :NFGI:;T3i  IH)  .EQ.O)  THEM 
MISS=MI33*1 
GO  TC  20250 
EMD  I F 

DO  2  ?CINT=l,MPOIMTS(IK) 

DO  2  PAP..*J-IETEP.  =  1 , 7 

3FP  (  POINT,  PARA>rETER)  =SPFZ  ( IK,  POINT,  PAPA-METE.F) 

2  CONTINUE 

0  FIT  THE  SCATTERING  POINTS  IN  THIS  WINDOW  WITH  A  3 -■-'ECTOR. 

20205  CALL  WFV 

IF  (FITFL.AG  .EQ.  0)  THEN 
N3AD=MBAD+1 

WRITE  (*■,*■)  'VERTIC.AL  FAILURE. AT  '  ,  IK,  MPCI.NTS  ( IH)  ,  Z 
'WRITE  (16,30002)  Z,  !  SUCKS  ( 'F.’iO  ,  K'K=  1 , 3  ) 

GO  TO  20204 
END  IF 
CALL  WFH 

IF  (FITFLAG  ■ EQ .  C)  THEN 
NB.AD=NB.AD+1 

WRITE  (  *  ,  *  )  '  HOP.IZONT.AL  FAILURE  .AT  '  ,  IK ,  NPOINTS  (  IH )  ,  Z 

C  -WRITE  FLAG  RECORD  FOR  THIS  .ALTITUDE  I  U  =  393.0  ) 

20250  WRITE  (16,90002)  Z , ( SUCKS (KK) , KK=1 , 8 ) 

GO  TO  20204 

0  'WRITE  GOOD  'v'ELCCITY 


IF  (TRP(IH)  .LT.  1)  THEN 

TP.PdH)  =  0 

ELSE 

TP.PdH)  =  10*LOG10(TRP(IH)  ) 

END  IF 
END  IF 

C.ALL  PHFIT 

RATE  =  FLOAT (NPOINTS dH) ) .NPROFS 
'WRITE  (*,90001) 

1  Z  ,  j  (IH )  ,  •/  (IH )  ,  W  ( IH )  ,  TRP  (IH )  ,  NPOINTS  (IH )  ,  NPV ,  NPH ,  R.ATE  , 

2  SLOPE, INTERCEPT 

L  FOFCIAT  dZ,  F4 . 0 , 2  (IX,  F6 . 1  I  ,  2  ( IX,  F5 . 1 )  ,  3  (  IX,  14  )  ,  j  1  IX,  F; 
Xi  =  FLO.AT  (NPOINTS  (IH)  ) 


::ooo344 
dC00345 
)  C  C  0  014  6 
'C000:4' 
■1000343 
■l':  30  34  9 


0  C  0  0  C  3  5  ; 
0  C  0  0  0  3  5  4 
0  0  000  3  5  5 
0  3  000  3  :6 
■  c  00  3  5“ 
0  C  0  0  0  3  5  3 
Q000C359 
0  C  0  G  0  3  60 
00000361 


OC000364 
00000365 
00000366 
0  0  C  0  0  3  6  7 
0  0  0  0  0  3  6  3 


0 3000371 

0:C003"4 


r; fi  n  n  7  R 

0  0  0  0  0  3 ' 9 
C GOO 0  3  60 
00000381 
000003^2 
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.  _  r  J  : 


■3 ) 


‘c:c4 I 


rHEM 


1  r  '  r::  AL'  .  : 

WRITE  !:5 

FCRM-^T  !1a  FX,"  BAT  DATA  THIT  IWTEF.VAL" 
WRITE  (*,50004) 

EM2  IF 

IF  (MISS. EC.- (KITES  I  THEM 
WRITE  (15,50005) 

FORMAT  (ix  5X,  "  riC  O.ATA  THIS  IKTERV.AL"  , 
WRITE  (*,50005) 

GO  TO  20101 
ELSE 

WRITE  (  * , * )  '  RESECTIONS :  ' 

WRITE  (*,*)  '  I'TOAX  VF.  =  0  ORMAX 

WRITE  (*,1C2)  (REJdP.EJ)  ,IREJ=1,4) 
FCPOiAT  (313,  IX,  13) 

GO  TO  20101 
END  IF 


TOO  EAD  -  ERROR  EXIT 

ERROR  EXIT  .AT  NERR  = 


90909  WRITE  (*,*) 
GO  TO  90950 


90910  IF  (LCOF.LT.3)  GO  TO  669 


'  ,  NERR,  '  ST.ATU5  =  '  ,  10 


SUBROUTINE  INNAME 
INN.AME  CREATES  SSP  INPUT  FILE. 

INTEGEP.*4  REJ,  IH,  NPCINTS  (  50  )  ,  INTERVAL ,  NP‘/,  NPVO  ,  TESTFL.AG  ,  F) 
1  MINH ,  MINV ,  N'lMR.AD 

CH.ARACTER*40  INFILE ,  OUTFILE 
CHARACTER  *2  7  INP.ATH 
CHARACTER* 19  OUT PATH 
CHARACTER*!  FITJM  (  3  ) 

INTEGER. *  4  YEAR  ,  MONTH ,  DAY ,  HOUR ,  MINUTE ,  SKI P 
CO.MMOK  /WINDl,/  3PP  ( 2  3  00 , 7  )  ,  3PPZ  (  1 5 , 2  3  0  C  ,  7  ) 

COMMON  /WIND2/  Z , U ( 50 ) , V ( 50 ) , W ( 50 ) , TRP ( 50 ) , 

1  REJ(4) , LINE (10) , 

2  WIDTH(50) ,IWT(2300) ,?XtSDyP(5G) , 

4  COSL(2300) ,COSM(230C) ,COSi;(:300) ,DVR(23C0; , 

5  MUMRAO (17), VRAD (17) 


:00C 0405 
00CCC4:: 
0 1}  O'  0  0411 
500C0412 

.-s  ^  4  i  -J 

>■  _  ^  i  J 

OOCC  0414 

00OC041" 

00000413 

OCOOC415 


c 

00000420 

C.ALL  REORDER 

'J000042  1 

0  0  0  0  '3  4  2  2 

c 

LOOKS  LIKE  WE 

MAY  K.AVE  SOME  WINDS! 

00000423 

c 

0CC0C424 

90940 

WRITE  (*,*)  ' 

SUCCESSFUL  RUN' 

00000425 

90550 

CLOSE  (15) 

00  000426 

CLOSE  (16) 

00000427 

CLOSE  (17) 

00000423 

CLOSE  (18) 

00000429 

P.AU3E  '  CR  TO 

EXIT’ 

0  0  0004  3  0 

STOP 

00000431 

END 

00000432 

0  0  0  C  0  4  3  3 

0C0C0434 

00C00435 

00000436 

G0CG0437 

0C000438 

r 0030435 

00 C 00440 

00000441 

00300442 

'j  0  c  C  'j  4  4 

C  0  0  '0  0  4  4  4 

■3  '000445 

'T'00044€ 

OT:  30447 
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^  jp  -r  ,  _  1  T  ^  r  1  *  T  ’ 

F' JL’N  ;  1  ‘  =CHA?.  ■'  I  i  0 C  -^4  c  ; 

F: II”!-!  '  2  )  =  CHAR  (  1 1  2  * 4  =  i 
F MUM ( 3 ) =CHAR { 1 1  *  4  S i 
WRITE  (  IMFILE,  30003  )  IMFATK,  Fr.'FT-l 
3  0 : 0  3  FORMAT  ( A2 " , 3A1 ! 

RETURN 

END 

SUBROUTirjE  OUTIiAOIE 
C  DUTNAME  CREATES  OUTPUT  FILEM'AMES. 

CHARACTER  *  2  ASCMGMTK , ASCD Ai , ASCHCUP. , ASCMIMUTE 
CHARACTER* 4 0  INFILE, OUTF I IE 
CHAP,ACTER*27  INPATH 
CHARACTER* 19  OUTPATH 

rNTEGEP,*4  P.EJ,  IH ,  NPOIMTS  (  50  )  ,  INTERVAL,  tlPV,  NPVO  ,  TE3TFLAG,  FITFLAC-, 
1  MINH , Mlir; , NUMRAD , YEAR , MONTH , DAY , HOUR , MINUTE 

COMMON  /WINCl,'  SRPtClOO,')  ,SPPZ(15,2300,7'. 

COMMON  /WIND2/  2 , U ( 50 ) , V  I  50 ) , W f 50 ) , TRP ( 52 )  , 

1  P.EJ{4)  ,LINE(10;  , 

2  WIDTH  f  50  )  ,  IWT  (2300),  PMSDVF.  (  50  !  , 

4  COSL(230C) ,COSM(23GO) ,COSN(2300) ,DVR:23C0) , 

5  NUMP.AD  ( IT  )  ,  VRAD  (  I "  ) 

COMMON  /WIND3  /  PI ,  mAX,  THMAXH,  TKMINH,  TKMAMV ,  TKMIMV,  MINH,MIir.', 

1  MSIGMA, TE3TFLAG, IH, NPOIMTS, INTERVAL, INFILE , CUTFILE . 

2  INPATH, OUTPATH, NPH,NFV,tIPV0, SLOPE, INTERCEPT ,  FITFLAG 
COMMON  /  SPPFILE,'  IFILE ,  YEAR ,  MONTH ,  DAY ,  HOUR ,  MINUTE 

C 

IF  (MONTH  ,LT.  10)  THEN 
WRITE  ( A3CMONTH, 90001 )  'O', MONTH 

900C1  FORMAT  (Al,Il) 

ELSE 

WRITE  (ASCMONTH, 90002)  MONTH 
90002  FCFMIAT  (12) 

END  IF 

IF  (DAY  .LT.  10)  THEN 

WRITE  ( ASCDAY, 900C1)  ’ 0 ' , CAY 

ELSE 

WRITE  (ASCDAY, 90002 )  DAY 
END  IF 

IF  (HOUR  .LT.  10)  THEN 

WR I TE  ( A3CHOUR ,90001)  'O', HOUR 

ELSE 

WRITE  (.ASCHCUR,  90002)  HOUR 
END  IF 

IF  (MINUTE  .LT.  10)  THEN 

WRITE  (A3CMINUTE, 90001)  'O', MINUTE 

ELSE 

WRITE  (ASCMINUTE, 90002)  MINUTE 
END  IF 

WRITE  (OUTFILE, 90003 ) 

1  OUT P.ATH,  ASCMONTH,. ASCD.AY.ASCHOUR.ASCMIM'UTE,  '  .MA.W 


:30c:4t;' 
3 :3CC4~: 


33j304-'; 

300004"4 

'  r,  r  r  ^  c 

■ ; 3334"3 


0003:483 

300C0451 

03000482 

00030483 

00303484 

00000435 

00000488 

OOOOC4S7 

C000048? 

000C0489 

000CO490 

00CC0491 

0CC0O492 

00000493 

00000494 

30000495 

00000496 

30000497 

C00CC49S 

000QC499 

0000C50C 

0  0  C  O'  0'  5  0  2 
00000503 
00000504 
00000505 
00000506 
0CC005CF 

A  P  A  r  c  p  p 

00000509 

P  '  A  ^  C  ’ 


201 


lolo: 

10102 


10201 

20001 


'MTH]0EP.*4  YE.'.?. ,  MONTH ,  0 
jlMEN’SlCM  '••.'IMEV 

?EAL*4  ElOMA, ElOMALAST 
[MTE3E?.*4  FL.AG.lOA 


-AY  ,  HC'JF. ,  MINO'TE 


.  .n  , 


“O' 


: :  I  ' 


1 .0'MMC  M 


lOMMOM 


,  MINH  ,  MltTE,  rrjiJiRAD 

'W'NDl  ■  SFP'23':,'’),S??2;:t,2:::,". 
'V;IND2/  Z.UI  5G  )  ,Vi  5-:  I  -  0  ’  ,  T?F  ■  2  :  i  , 
P.EJ(4)  ,  lime;  10.:  , 

WIDTH ( 50) , :WT'23 ;c i , EM3DV? ; 5 ' ■  , 
CC3L(2300) ,COSM(2:C0i ,COS:il23CC 
NUMP.AD  (171,  VF.AD  (  I"  ' 

/WIMD3,/  FI,’v'M.A.X,TKMAj.;k,TKH::;K,  THMAX'.-', 
NSIGMA, TESTFIAG, IH.MPOIMTS,  INTEP' 
INPATH ,  OUTPATH ,  NFH ,  MP’7 ,  NP', 


,  MINH.Mirr 


J  ,  3  LO  r : 

COMMON  /  S F PF I L E ./  I F I LE ,  YEAR ,  MONTH ,  DAY ,  HOUR ,  MI 

DO  10101  lA  =  1,3 
WINDV(IA)  =0.0 
DO  10101  13  =  1,3 
A(IA,IBI  =  0.0 
CONTINUE 

DO  10102  II  =  1,17 
MUMP.AD(II)  =  0 
VP.AD(II)  =  0 
CONTINUE 

NPV  =  NPOINTS(IH) 

DO  10201  POINT  =  l,NPOINTS(IH) 

IWT( POINT)  =  1 

SIMZAN  =  SQRT  (SIM(SPP(POIHT,  2  )  *PI.'13C)  **2 
SIN(SPP(FCINT,4)  *PI.''130)  “2) 


;  0  C  0  0  5  3  5 
:3C005 

:o:co53  ? 
/  0  0  0  0  5  4  .■ 
oo:ooE4: 
:oooc54; 


00  0 
2  2  00 


0545 
054" 
0  549 
0543 

c;  = 


00000551 

r'  0  f  r.  n 

OOOOC552 


IF  ((SINZAX 

.LT.  SIN(TKMINV*PI/1S0) )  .OR. 

20000554 

(SINZAX 

.GT.  SIN(THMAXV*PI dSO) ) )  THEN 

00C0C555 

IWTl POINT)  = 

0 

00000556 

MPV  =  NPV  - 

1 

0C000557 

IF  (NPV  .LT. 

MIN’/)  THEN 

G0G00559 

FITFLAG  =  0 

C  C  0  0  "  5  5  5 

GO  TO  90909 

;200G552 

END  IF 

2  0  0  0  0  5  -1 

END  IF 

OOOOC562 

COSH  POINT) 

=  SIN(SPP(FOINT,  3)  *PI./i3C) 

00000563 

COSM( POINT) 

=  SIN(SPF(POINT,4)  *PI,'130) 

00000564 

COSN( POINT) 

=  SQP.Td  -  COSL{?OINT)  **2  -  CC3M  (  POINT '  *  *  2  ) 

00000565 

CONTINUE 

j  0000  56  6 

SIGI4ALAST  = 

1E8 

0000056" 

FL.AG  =  0 

20000563 

DO  10301  POINT  =  l,NPOINTS(IH) 

■'  C  0  0  0  ^  6 

IF  (IWT(POINT)  .EQ.  0)  GO  TO  103G1 

20000570 

A  ( 1 ,  1 )  =  A  (  1 

,  1 )  +  COSL( POINT) **2 

0  0  0  0  0  5  7  1 

Ad,  2)  =  A(1 

,2)  *  COSL ( POINT ) *COSM( POINT) 

0  C  0  0  G  5  "  2 

A  (  1 ,  3  )  =  A  ( 1 

,3)  +  COSL  (  POINT ) ’*COSN(  POINT) 

00GC057? 

A  (  2 , 2  )  =  A  (  2 

,2)  +  COSM(POINT) **2 

2  0  0  0  0  5  "  4 

A  (  2  ,  3  )  =  A  (  2 

,  3 )  +  COSM(POIMT) *COSN( POINT) 

2  0  0  0'  C  "  "  ^ 

202 


O  O  O 


A  3  ,  '  = 

WIMr’.'  3 


.“i  i  J.  ,  i  ( 

A  (  1 , 2  ' 

c  j.  JrL“.  i 


00  TO  3':^'j2 
ErjDIF 

OflH)  =  iWirJCVi  1)  *  '  A(2,  2  ' -A!  3,  3  ;  -  A'2,:i**. 

1  WINDV: 2 1  *  I Ai2 , 3 ) 'At 3 1  -  A ■ 3 , 2 ■ "A ‘ 3 , 3 

2  WinOV  (  3  )  *  '  A  ( 1 , 2  )  *  A I  2  ,  3  .)  -  A  i  1 ,  3  ■  'A  ■  2 , 2  ' 

V(IH)  =  (WINDVf 2 ) * ;A(2, 3 ! *A  3, 3-  -  A . 1 , 2 > *A ; 

1  WIND'2(2)  *  ( A' 1,  1)  *A(  3  ,  3  )  -  A' 3,  I'}**  2'  - 

2  WiriDV  i  3  )  *  (Ai  1 ,  3  I ‘A(  1 , 2  >  -  A;1,1'*A.2,3 

W!IH)  =  (WISDOM  1 ) * ; A( 1 . 2 1 *A(2, 3 '  -  A'3,3'*Ai 

3  WIMCV( 2 ) *  I A( 1 , 2  I *A( 1 , 3  I  -  A(l,Ii*A'2,3 

2  WINDVf  3  )  *  (Ad  ,  1  i ’Ai:  ,  2  )  -  A.  (  1 , 2  '  *  *2  i  ' 

AALCULATE  THE  STAOIDARD  DEVIATIOM  dIOt-LAi 
ERRORSUM  =  0 

DO  10401  POINT  =  l.NPOINTSCH) 

IF  (IWTIPOINT)  .EQ.  Cl  00  TO  10401 

D’>/R  (  POINT )  =  3FP  I  POINT ,  2  )  -  U  dH  )  *CCSL  i  FCIMl 

ERPOP.SUM  =  ERP.ORS'uT-1  *  DVR  (  POINT)  » *2 
)1  CONTINUE 

SIGMA  =  SCRT{ERRCRSUM.'MPV' 

DO  10  501  POINT  =  l,NPOINTSdH) 

IF  (i;'IT(  POINT)  .EQ.  0)  GO  TO  105C1 

IF  (.ABS  (DVR  (POINT)  )  .GT.  NSIGM_A*SIGM.A)  THEM 

IWT( POINT)  =  0 

FLAG  =  1 

NPV  =  NPV  -  1 

IF  (NPV  .LT.  Mlir/)  THEN 

FITFL.AG  0 

GO  TO  909^.0 

END  IF 

ENDIF 

11  CONTINUE 

IF  (FLAG  .EQ.  0)  GO  TO  20002 
IF  (FLAG  .EQ.  1)  THEN 

IF  (SIGMA  .GE.  0.999*SIGM.ALAST)  GO  TO  20002 
IF  (SIGMA  .LE.  0.01)  GO  TO  20002 
3IGMA.LAST  =  SIGMA 
GO  TO  20001 
ENDIF 

:COD  VELOCITY. 


(ABS(U(IH) ) 

.GT  . 

OTIAX) 

( ABS (V( 

:iH)  ) 

.GT. 

’/MAX) 

(.AES  (W( 

IH)  ) 

.GT. 

•,T4AX,'10 

:  (*, *) 

'  IH, 

U,  V, 

W  =  '  , 

,.AG  =  0 

)  90909 

'ITFLAG 

.EQ. 

1)  THEN 

PAlSDVRdH)  =  0 

DO  10601  POINT  =  l,NPOINTS(IH) 

IF  (IWT(POINT)  .EQ.  0)  GO  TO  10601 


0000063'9 
00000613 
OOGCC611 
00000612 
00CCC613 
00000614 
O'  C  0  0  0  6 1 5 
00000616 
0006061“ 
j  u  0  'j  1 5 
0000061? 
Q0CC0620 
00000621 
OOOOC622 
C0000623 
00000624 
O'  0  00062  5 
0000062- 
0000062“ 


00CO063O 
'3  0  ^  3 
■0  0  “  0 
0C00G633 
00GO0634 

'0  0  0  j  '0  6  -  - 

OOOOC636 

00C0Q637 

00000633 

0000063? 
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‘ j’l’MP.AO  '  I ZA  i  =  M'JMRA.r  i  IZA.i  •  1 
13 '-I  COMTIN'JE 

IF  .  IT.  •  ’  THE'! 

P-MSD'.'?. '  IH)  =  FQPT  i' PT'ISCVR  •:  IK  .  !!?':• 

DO  10''01  lALPHA  =  1,16 

IF  (ML'MP.ADdALFHA)  .EQ,  0)  00  TI  i;":: 

C  WRITE  (*,*)  ' ZA, VRAD,MUMRAE=  '  , I ADPHA , VPAD ■  I ADPHA ■  , KOMPAD ; I ADI  HA 

VRADiIALPHA)  =  3QRT  ( VPAD  i  I  ALPHA  riLT-lF  AD  '  lALPHA ■ 

ICO 01  OCNTIMUE 
END  IF 
END  IF 

90909  RETURN 
END 

SUBROUTINE  WFH 

******'****«'****«******'**«***#*********«*****’**************«***'***'*V**W 


C  THIS  SUBROUTINE  CALCULATES  HORICCKTAL  WINDS  FPCM  MA.FSTAR  SFPS. 

C  AUGUST  17,  1990 

7HARACTEP.*40  INFILE,  OUTFILE 
CHARACTER* 27  INPATH 
CHARACTER*  19  OUTP.ATH 

IHTEGER*4  REJ,  IK,  POINT,  NPCINT3  (  50  )  ,  INTERV.AL ,  NPV,  .NFVO  ,  TESTFLAG, 
1FITFLAG,MINH,MINV,NUMRAD 
INTEGER*4  YEAR , MONTH , DAY , HOUR , MINUTE 
DIMENSION  H(3, 3) ,WIND(3) 

REAL*4  SIGMA,  SIGMAL.^lST,  PI 
INTEGER*4  FLAG,IZA 

COMMON  /WINDl/  SPP ( 2 300 , 7 ) , SPP2 ( 1 5 , 23 00 , 7 ) 

COMMON  /WIND2/  Z , U ( 50 ) , V ( 50 ) , W ( 5C ) , TRP ( 50 ) , 

1  REJ(4)  ,LINEau)  . 

2  WIDTH(50)  ,  IWT;23  0  .  ,  PJISDVR  i  50  >  , 

4  COSL(2300) ,COSM(2300) ,COSN(2300) ,DVR(2300) , 

5  NUMPAVD(17)  ,  VRAD(17) 

COMMON  /WIND3/  PI ,  VMAX,  THMAXH,  THMINH ,  THMP'.'L.  ,  THMIN^/,  MINH  ,  MIM/ , 

1  NSIGMA, TESTFLAG, IH,NPOINTS  INTERV.AL, INFILE , OUTFILE , 

2  INPATH, OUTPATH,NPH, NPV, NPVO, SLOPE, INTERCEPT , FITFL.AG 
COMMON  .'SPPFILE/  I  FILE ,  YEAR,  MONTH ,  DAY ,  HOUR ,  MINUTE 

C 

DC  10101  I A  =  1,3 
WIND(IA)  =  0 
DO  10101  IB  =  1,3 
H(IA,IB)  =  0 
10101  CONTINUE 

DO  10102  II  =  1,17 
NUTIRAD  (II)  =  0 
VRAD (II)  =0 
101C2  CONTINUE 

NPH  =  NPOINTS(IH) 

DO  10201  POINT  =  l,NPOINTS(IH) 

IWT( POINT)  =  1 

3IN2AX  =  3QRT(SIN(SP?(POINT,  3)  *PI,'180)  **2 
1  1-  SIN(SPP(POINT,  4)  *PI./130)  **2  I 


0 C OC . c  '  j 
j  C  0  'j  C'  c  “  4 
00000675 
00000 6" 6 
0000067" 
00000578 
OOQOC67? 
G000C68O 
00000681 
00000632 
0C00C683 
00000684 
0  0  C  0  063  5 
00000686 
00000667 
00OC0688 
OG0C0689 
!■  0  C  0  0  6  9  0 
0000G691 
00000692 

00000694 
00000695 
0  0  0  00  69  6 
OOOOC69" 
0  0  C  0  0  6  9  3 
00000699 
00000700 
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i  ' i ?H  .  1-T  .  M IliH 


ccsMiroir’Ti  =  sim:  s??  ■  p";:r;T,  4  ^ 

cc SN  (  ?ci:;t I  =  ; :  -  posl .  fp 

C'jMTIML’E 

SIGM^LAST  =  :E9 

FLAG  =  'J 

T~,Q  1  7  r  PC^^IT  =  1  I  I"  ‘ 

IF  (  :v:t  ( FGiriT)  .e;.  0)  gc  tg  i 
H(l,ll  =  Hd.i.i  ^  CCSL FOriiT' * 
H!l,2)  =H(1,2)  »  COSL  I  FC'INT  .  * 
H(2,2>  =  H(2,2i  -  CCSM(  pox::':)  * 
v.'iNDd)  =  wiricd;  ^  s?f!?oi::T, 


OSM FOIMT ) 


WIND!  2)  =  VJINDd) 


-  COSLiPCIUT)  *AdH- 

-  SrP(POIMT,2)  *'GC3Kd( 

-  COSM(POItlT)  *WdH) 


10301  CONTINUE 

H(2,l)  =  Hd,2i 

DET  =  Hd,  1)  *H(2,2)  -  H(l,2t**2 
IF  (ABS(DET)  .LT.  l.OE-"'  THEN 
WRITE  (*,*)  'MV'H;  NO  SOLUTION' 

FITFLAG  =  0 
GO  TO  90909 
END  IF 

U(IH)  =  (WIND(l) *H(2,2)  -  WIND ( 2 ) *H (1 , 2 )  '  DET 
V(IH)  =  (Hdd)  *WIMD(2)  -  H  (1 , 2  )  *WINDd  )  )  ■DET 
C  CALCULATE  THE  STANDARD  DEVIATI-ON  (SIGMA) 

ERRCRSUM  =  0 

DO  10401  POINT  =  l,NPOINTS(IH) 

IF  (IWT(POINT)  .EQ.  0)  GO  TO  10401 
DVR(POINT)  =  SPP(POINT,2)  -  U ( IH ) *C03L ( POINT) 

1  -  V( IH) *COSM( POINT)  -  W(IH) *COSN( POINT) 

ERRORSUM  =  ERRORSUM  +  DVR ( POINT) * *2 
10401  CONTINUE 

SIGMA  =  SQRT(ERF.ORSUM/NPH) 

DO  10501  POINT  =  l.NPOINTSdH) 

IF  (IWT( POINT)  .EQ.  0)  GO  TO  10501 

IF  ( ABS( DVR ( POINT) )  .GT.  NSIGMA*SIGMA)  THEN 

IWT( POINT)  =  0 

FLAG  =  1 

NPH  =  NPH  -  1 

IF  (NPH  .LT.  MINH)  THEN 

FITFLAG  =  0 

GO  TO  90909 

END  IF 

END  IF 

10501  CONTINUE 

IF  (FLAG  .EQ.  0)  GO  TO  20002 
IF  (FLAG  .EQ.  1)  THEN 

IF  (SIGMA  .GE.  0 . 999’"SIGMALAST)  GO  TO  20002 
IF  (SIGMA  .LE.  0.01)  GO  TO  20002 
SIGMALAST  =  SIGMA 
GO  TO  20001 
END  IF 

C  GOOD  VELOCITY. 

200C2  IF  (  (ABSlU(IH))  .GT.  '/MAX)  .OR. 


jooc":9 


died 3  3 
;'C00C"34 


^  0  ■''  0  ■'  I  " 
OOOOOC  3  3 
.jOCOG'35 
3000C''40 
300C'C'-41 
COOOC“42 
000C0':4  3 
0  0  0  0  0  "  4  4 
00000-45 
00000746 
OCOOO"47 
00000743 
00000749 
00000750 
00000751 
OCOOO"52 

'J  0  L  0  'j  ^'4 
0  L  0  0  0 '55 
000GQ756 

00000-53 

00CC0759 

0CC0G760 

00000761 

00C00762 

Q0000763 

00000764 

00000-65 

00C0G“66 


205 


ASS  : I  I H  j  '  .  GT  .  '.SiAH 
A.BS  V;  i  IH  ;  i  .  GT  .  ‘.'MAGG  2  '  ' 


END  IF 

IF  (FITFTAG  .  EQ .  1/  THEIJ 
RMSDVRiIHi  =  0 

SO  lOcCi  ?oi::t  =  :,>;poii:ts:  :H! 

IF  lIWTiFOINT;  .E2.  S )  GO  TO  II-GI 
SVRiPOIMT)  =  SFFiFOiriT  S!  -  G  ■  IH  »:05S:F0i:iT 
1  -  V(  iHi 'cosMi  h,imt.  -  w ;  IH :  “Gss:;  ■  FO  :::t  ^ 

RMSDVRdH)  =  RMSSVRdHi  -  SVR  1  f  0 I’d  :■  *  * _ 

SA  =  (  lAO  PI  )  *ASI:J(30RT(  1 -ccsiofoiht;  *  *  j  '  • 

ISA  =  IMT(ZA)  +  1 
IF  d2A  .GT.  1")  THEM 
WRITE  (  *,  *  '  dZA  =  '  ,  ISA 
FITFLAG  =  0 
GO  TO  9090A 
END  IF 

IF  i IZA  . EQ.  17 )  IZA  =  16 
VPADdZA)  =  VR.ADdZA/  DVR  (  PC IM'T '*  *2 
MUMRADdZA)  =  NUMP.AD(IZA)  *  1 
106  01  CONTIinJE 

IF  (NFH  .GT.  0)  THEN 
RMSDVR(IH)  =  SQRT(RMSDVR( IH) /NFK' 

DO  10701  lALPHA  =  1,16 
IF  (NUMPADdALPHA)  .EQ.  0)  GO  TO  10701 
C  WRITE  (*,*)  '  ZA,  VRAD,NUMRAD=  '  ,  lALPHA,  VRAD  (  lALRHA)  ,  MUMPAD  d.ALFHA.  i 

VP..ADdALPHA)  =  3QP.T{yP.AD(IALFHA)  NUMRAD  ( I.ALFHA;  ) 

10701  CONTINUE 
END  IF 
END  IF 

90909  RETURN 
END 

SUBROUTINE  PHFIT 

********************************************************************** 


C  THIS  SUBROUTINE  FITS  A  STRAIGHT  LINE  TO  THE  V.AP.IATICN  OF  VELOCITY 
C  V.ARIANCE  VS  ZENITH  ANGLE. 

C  JULY  23,  1990 

CHAFJ\CTER*40  INFILE ,  OUTFILE 
CHARACTEP.*27  INP.ATH 
CHARACTER* 19  OUTPATH 

COMMON  /SPPFILE/  IFILE , YEAR, MONTH, DAY, HOUR , MINUTE 
INTEGER  *  4  YEAR , MONTH , DAY , HOUR , MINUTE , 

1  REJ, IH.NPOINTS (50) , INTERVAL, NFV, NPVO , TESTFLAG , FITFLAG , 

2  MINH,  MIN’/,  NUMRAD 
REAL *4  INTERCEPT 

COMMON  /WINDl/  SPP ( 2300 , 7 ) , SPFZ ( 15 , 2300 , 7 ) 

COMMON  /WIND2/  Z , U { 50 ) , V ( 50 ) , W ( 50 ) , TRP ( 50 ) , 

1  REJ (4 ), LINE (10) , 

2  WIDTH(50) , IWT(2300) ,PI1SDVR(50)  , 

4  COSL(2300) ,COSM(2300) ,COSN(23Q0) , DVR (2 300) , 

5  NUMRAD ( 17 ), VRAD (17) 

COMMON  /WIND3/  PI ,  VMAX,  THMAXH,  Th'MINH,  THMAXV,  THMIIP/,  MINK,  MIMd, 

1  NSIGMA,TESTFLP,G, IH.NPOINTS, INTERVAL, INFILE , OUTFILE , 

2  INPATH, OUTPATH, NPH, NFV, NPVO, SLOPE, INTERCEPT , FITFLAG 


SUMVR  =  0 
SUMVRPH  =  0 
SUMPH  =  0 
SUMPH2  =  0 
SUMI  =  0 

DO  10101  lALPHA  =  1,17 


3  0  0  0  C  “  3  b 

3  j  0  3  0  ^  9  3 

3'3C007?1 

’7000792 

3000C793 

330C0794 

0CC00795 

0CCCC756 

0  0  0  0  0  ~  9  7 

0  OMj  (j  0  /  ^  s 

OODOO-O 

00 000  SO 

00000501 

00000802 

00000803 

0OOC0304 

0000C305 

00000806 

000Q08C7 

00000808 

00000809 

00000810 

00000811 

C0000812 

00000813 

00000814 

00000815 

00000815 

00000817 

00000818 

00C0C819 

00000820 

00000821 

00000822 

00000823 

00000824 

00000825 

00000825 

OOOCC827 

00000328 

00000829 

00C00830 

00000S31 
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IF  I !  lAlFH. 

=  A'lIT.’"  *  ' 
-^^Fr.'FFH  =  F’'i'r,’Fri 
* 

-j  \*  p  H  2  =  A  il  ;■!  p  H  2 
I'JMI  =  2','MI  »  1 


«  s-si-ii 


32C?E  =  ’  S'JM:  ♦SUFr.'PPK 
INTERCEPT  =  i3’J:T;R  - 
ELSE 

SLOPE  =  0 

INTERCEPT  =  2 

EMC  IF 

END  IF 

RETURN 

END 

SUBROUTINE  REORDER 


REORDERS  OUIFUT  FILES  IN  DESCENDING  HEIC-KT.  0000^  =  5: 

THIS  PORTION  OF  THE  FROGRA-M  IS  SPECIFIC  TO  A.  43KM  HEIGHT  RACJGE  2:C'CC33-4 


CHARACTER.*!  TAB 

CHARACTER*40  INFILE , OUTFILE 

DIMENSION  H(50)  ,U(50)  ,V(;Co  ,WI50)  ,TP.Pi50)  , 

*XH(50) .RT(50) ,SLI50) , ICFT'50) 

INTEGER*4  IFILE , YEAR , MONTH , DAY , HOUR , MINUTE, NPOINTS ( 50 ! 

COMMON  /WIND3  /  PI ,  '-’MAX,  THMAXH,  THMIMH,  THMAXV,  THMIN"/,  MINK  ,  MI.*,"/, 

X  .:D:C;L'-.,  TESTFLAG,  in,  NPOINTS,  IMTERV.AL,  INFILE,  OUTFILE 

COI-IMON  /SPPFILE/  IFILE,  YEAR,  MONTH ,  DAY ,  HOUR,  MINUTE 
C 

TAB=CHAR(9) 

WRITE  (♦,*)  "  REORDERING  FILES  BY  DESCENDING  HEIGHTS” 

REWIND  (17) 

90311  READ  (17, 101,END=90940)  YEAR, MONTH, DAY, HOUR, MINUTE 
101  FOPJIAT  (512) 

IF  (MONTH. EQ,0)  GO  TO  90940 
CALL  OUTNAME 
CLOSE  (16) 

NERR=8 

OPEN  ( 16, ERR=90950, FILE=OUTFILE, STATUS="OLD" , FOPM= " FORM.ATTED" ) 
IH=1 

90912  READ  ( 16 , 90001 , END=90920, )  H ( IH) , U ( IH) , V( IH) , W ( IH) , TRP ( IH ) , 
*XH(IH) ,RT(IH) ,SL(IH) , ICPT(IH) 

90001  FORJ4AT  (9  (E13 .4)  ) 

IH=IH+1 

GO  TO  90912 

90920  REWIND  (16) 

J  =  15 

90921  I=J 
K=0 

90922  WRITE  (16,90002)  H  ( I )  ,  TAB ,  U  ( I )  ,  T.AB,  V  ( I )  ,  T.AB,  W  ( I )  ,  TAB  ,  TRF  i  I  '  , 
*TAB ,  XH  ( I )  ,  TAB  ,  RT  ( I )  ,  TAB  ,  SL  ( I )  ,  T.AB ,  ICPT  ( I ) 

90002  FORMAT  ( E13 . 4 , 8 ( A1 , E13 . 4 ) ) 

IF  (I.EQ.l)  GO  TO  90911 
K=K+1 

IF  (K.EQ.l)  THEN 
1=1+28 
GO  TO  90922 
END  IF 

IF  (K.EQ.2)  THEN 
1=1-14 


300005:6 
.3000035"' 
OO'OOOSSS 
.3  0000  55  9 
.■'000CS60 
00000861 
0  0  0  C  C  S  6  2 
0  0  0  C  S  6  3 
00000863 
OOOC0864 
00000865 
OOOOOS66 
00000867 
00000868 
00000869 
OOOOOS70 
00000871 
OCOOC872 
00Q00875 
000008"4 
00000875 
00000375 
0C000876 
00000877 
00000878 
00000879 
00C00S80 
C0000881 
00000832 
00000883 
00000384 
00000885 
COO 00856 
0000Q8S7 
00000838 
00000889 
00000890 
00000891 
0QC00S52 
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The  ISR  and  IDi  Wind  Analysis  Program  ISRIDIIDIG.f 

The  FORTRAN  program  ISRIEIITIO- .  f  is  //rirsen  rs  scmpiy 
wish  Che  FCRTRAi-I  77  standard.  The  runtime  prog^a.m.  has  heen 
compiled  as  a  sta.nd  alone  application  using  the  Abscrt 
FORTRAN  II  Compiler  running  in  the  Apple  M?>;  en.'.'c r cnmeut  . 
Execution  has  been  perfor.med  on  a  16MHz  Macintosh  Ilex  'Auch 
8.0Mb  of  .memory  running  under  System  7.1. 

The  following  data  folders  and  files  are  essential  to 
execution : 

ISRDATA  folder,  containing  the  ISR  data  i.n  files  of  the 

form 

SCENE. $.4  where  $  is  2  for  Scene  II  and  3 
for  Scene  III  data,  and  file  TUREKFILE. 

TUREKFILE  contains  a  listi.ng  of  the  start  and 
end  times  and  line  of  sight  azimuth  of  each 

ISR  measurement.  Each  is  associated  with  a  three 

digit 

number  AAA  which  is  entered  during 
execution,  to  determine  the  com.parison  interval. 

IDIGNSEW  folder,  containing  the  GROVES  analysis  program, 
output  files  XXXXXXTIDE,  where  .XXXXXX  are  the 

year,  mont.h  and  day  of  the  24  hour  interval  of 

the  comparison.  The  appropriate  file  is  chosen 

automatically . 

INFILES  folder,  containing  the  IDI  scattering  point 
parameter  data  files  SPP  -  GR  YYY  from  which 

the  appropriate  IDI  wind  profile  is 

calculated.  YYY  is  entered  during  execution. 

OUTFILES  folder,  where  the  calculated  IDI  wind 
profile  is  stored  as  file  ZZZZZZZZ . MAW , 

where  ZZZZZZZZ  are  interval  midpoint  month,  day, 

hour  and  minute. 


All  these  files  reside  on  the  disc  MAXTOR600.  Execution 
on  other  platforms  will  require  an  appropriate  global  name 
change  in  the  source  code. 

Output  is  a  single  tab  spaced  columns  ASCII  file 
AAACRKPLOT,  where  AAA  is  the  three  digit 
TUREKFILE  interval  number  above. 

Defenitions  of  the  column  headings  follow  on  the  next  two 
pages,  and  are  followed  by  a  sample  of  the  runtime  screen. 
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OEriNiTiom  or  orovcs,  idi  aho  isr  data  sets 


HEIGHT  (XM) 
lOIC  EM 
ERR  EW 

IDIG  NS 
ERR  NS 
IDIG  W 
ERR  W 
IDI  EW 

ERR  EW 
IDI  NS 
ERR  NS 
IDI  W 
ERR  W 
ISR  EW 
ERR  EW 

ISR  NS 

ERR  NS 

EW  IDI-ISR 

NS  IDI_ISR 

VRG 

ERR 

VRP 

ERR 

VRIDI 

ERR 

VPIDI 

ERR 


ZonAl  eo«poa*nt  iroa  th«  Crovas  Analysis,  ml  m 

Error,  coaputsd  Iroa  chs&gs  in  Groves  over  coaparison  interval  and 
inherent  aeasureaent  error,  a/s 

Meridional  coaponent 

Error 

Vertical  coaponent,  ca/s 
Error,  ca/s 

Zonal  coaponent  as  aeasured  by  the  IDI  technique,  assuaing  sero 
vertical  velocity 

Error,  coaputed  as  chanqe  in  IDI  over  coaparison  interval 

Meridional  coaponent 

Error 


Vertical  coaponent,  ca/s 
Error,  ca/s 

Zonal  coaponant  as  aaasured  by  the  Incoherent  Scatter  Radar 

Error,  coaputed  iroa  the  change  in  393*  (or  213*)  aaiauth  velocity 
over  the  coaparison  interval,  and  inherent  aeasureaent  error 

Meridional  coaponent 

Error 

Modulus  oi  the  sonal  IDI-ISR  velocities 
Modulus  oi  the  aeridional 

Groves  line  oi  sight  in  the  393*  (or  123*)  aziauth  direction 
Error,  scaled  iroa  the  3  coaponent  error 

Groves  line  oi  sight  in  the  303*  (or  213*)  aziauth  direction 
Error 

IDI  line  oi  sight  in  the  393*  (or  123'}  aziauth  direction 
Error 

IDI  line  oi  sight  in  the  303*  (or  213*)  aaiauth  direction 
Error 
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I 


VRISR  ISR  lin#  of  sight  in  ths  393*  Jor  123  )  ssimth  dirsction 

ERR  Error 

VPISR  ISR  line  of  sight  in  the  303*  (or  213  )  szunith  direction 

ERR  Error 

EW  IDI  Zonsl  IDI  wind  from  3  coaponent  cslculotion 

NS  IDI  Meridionsl  IDI  wind  fro*  3  component  cslculetion 
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^'RUL’RHfl  '  rn  '  ui  :  ■  U  I 

ENTER  TUREK  i  HTER'JhL  NUtlEER 
■  THREE  FiOUPEf  ,  WITH  LEliDHiG  ZERO' ES.'> 

':7ft 

iTS  CORREiPOfCift  TO  DMTE/TIflE  S'j04101200 
IF  CORRECT  ENTER  V.  IF  INCORRECT,  ENTER  N 
‘OR  ENTER  hNV  OTHER  KEV  TO  EXIT;- 
PROCESSING  I  SR  DRTfi 


DETERMINE  PROFILE  TIMING  SEQUEtCE 
ENTER  0,  1  OR  2  FOR  EACH  PR-QFILE 

0  REFlO  PROFILE  DRTfi,  BUT  DO  NOT  USE 

1  REfiO  fiND  USE  PRCFILE  DfiTfl 

2  PROFILE  MISSING  FROM  DftTfi  -  SKIP 

NOTE  -  hLL  six  must  BE  DEFINED 

0  1  2  S  4  5 
111111 

SEARCH  I  NO  FI LE  MfiXTOROOO  1  SR  DATA : SCENE .2.4 


290410  120043  2 

70  0)0  -31.35  93.44 


75  OCiOO 

29.5000 

4.89000 

1 

1 

76  0000 

33.7000 

5.56000 

1 

2 

77  0000 

32.8300 

6. 11000 

1 

3 

78  0000 

31.4200 

5. 13000 

1 

4 

79  OCKX) 

32.9700 

6  25000 

1 

5 

80  0000 

39.3000 

6. tOOOO 

1 

6 

81  0000 

44  6600 

8  34000 

1 

7 

82.0000 

41  2100 

7.7300) 

1 

8 

83.0000 

35. 1300 

9.09000 

1 

9 

84.0000 

33.4700 

9.52000 

1 

10 

&5.0000 

55.8800 

9.84000 

1 

11 

86  0000 

48  9800 

10  8600 

1 

12 

87.0000 

57.4200 

10  4000 

1 

13 

88.0000 

41.7500 

12.2600 

1 

14 

89.0)00 

36  1900 

10.9300 

1 

15 

90.0000 

1  00000 

10  2300 

1 

16 

91.CKX)0 

-18  9800 

9  98000 

1 

17 

92  0000 

-43.6200 

9.91000 

1 

18 

93.0000 

-45.81(Xi 

10.2000 

1 

19 

94.0000 

-49  73(Ki 

9 . 35000 

1 

20 

95  OOOiT 

-44 . 7600 

11.5400 

1 

21 

96.0000 

-62 . 0700 

12.6600 

1 

22 

97  0000 

-52.6500 

13.3900 

1 

23 

5  303 
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■dyu4  '0  1 

121745 

4 

70  00 

3  '30 

36'  '3'9 

73  0000  3  53000 

2.5  1000 

2 

1 

74  riOOO  -14  2200 

5  50CIOO 

75  0000  -7  '30000 

4  81000 

O 

70.0000  -4  77000 

4  08000 

4 

77  0000  -15  6600 

3 . 83000 

5 

7o .  C*000  —17. 0600 

3 . 550CI0 

■■y 

6 

79,0000  -20.2700 

3  47000 

7 

30.0000  -18.9800 

3.25000 

2 

8 

81  0000  -19.3000 

3.25000 

9 

82.0000  -24.4300 

4.  10000 

2 

10 

83.0000  -32  2300 

5  64000 

2 

11 

84  0000  -35.0800 

7.05000 

2 

12 

85.0000  -27.2700 

7  60000 

O 

JL 

13 

86  0000  5  03000 

9  25000 

14 

87.0000  17  9100 

10.2600 

2 

15 

88 , 0000  3 1 . 2000 

8.97000 

2 

16 

39.0000  28.2700 

e.ocooo 

17 

90  0000  24.2100 

6.98000 

2 

18 

91  QQOQ  15.7300 

6.51000 

2 

19 

92.0000  5.66000 

6.75000 

2 

20 

93  0000  4 . 48000 

6.57000 

2 

21 

94  0000  -2.60000 

7.70000 

2 

22 

95.0000  -1.67000 

7.89030 

2 

23 

'96.0000  -14.3500 

8.96000 

2 

24 

97.0000  -20.9500 

1 1 . 1500 

2 

25 

890410 

70.00 

124405 

-31.33 

25. 

72.0000  -14.7600 

3.30000 

3 

1 

73.0000  -15.4400 

1.35030 

3 

2 

75.0000  -4.97000 

1.91000 

3 

3 

77.0000  -8.97000 

12.80)0 

3 

4 

78.0000  -9.01000 

3.49000 

3 

5 

79.0000  -11.2200 

4. 17000 

3 

6 

80  0000  -14.9000 

6.C«000 

3 

7 

81.0000  -27.3400 

5. 19000 

3 

8 

82.0000  -38.9200 

3.98000 

3 

9 

83.0000  -30.5200 

3.51000 

O 

10 

84.0000  -32.5700 

4.36000 

3 

11 

85.0000  -7.69000 

7.64000 

3 

12 

86.0000  7.47000 

7.77000 

3 

13 

87.0000  27  7600 

6. 12000 

3 

14 

88.0000  27.0300 

7.86000 

3 

15 

89.0000  20.300C 

8.72000 

3 

16 

90.0300  5.90000 

8.43000 

3 

17 

91.0000  9.68000 

7.91000 

3 

18 

92.0000  7.89000 

6.46000 

3 

19 

'93.0000  3.31000 

6.96000 

3 

20 

94.0000  -11.3500 

7.49000 

r> 

21 

95.0000  -30.7900 

7.82000 

3 

22 

96.0000  -47  6100 

7  76000 

o 

23 

97 . 0000  -55 . 1 100 

9 . 9 1000 

o 

24 

I 


213 


890410  131012  4 

?0  00  -3  50  35  88 


77 .  OCiOO 

-22  6200 

14  8600 

4 

1 

78 .  OOCiO 

-23.8100 

2.57000 

4 

80 . 0000 

-34  7500 

2 , 82000 

4 

3 

81.0000 

-36 . 1500 

4  36000 

4 

4 

82 . 0000 

-37.5700 

3.34000 

4 

C 

■J 

83.0000 

-30.0000 

5  24000 

4 

6 

84  iDOOCi 

-14  7000 

7. 17000 

4 

f 

85 . 0000 

- . 560000 

8.93000 

4 

8 

86  0000 

1 1 . 6000 

9.89000 

4 

9 

87 . 0000 

18.3200 

7.91000 

4 

10 

88  0000 

34.0800 

7  9800^^ 

4 

11 

89.0000 

36.6900 

7.28000 

4 

12 

90.0000 

32. 1800 

7.21000 

4 

13 

91.0000 

15,6000 

6  97000 

4 

14 

92.0C«0  -9.000000E-02  7.75000  4 
yO.CtOOO  -17.7100  8.37000  4  16 

94.0000  -31.9200  8.78000  4  17 
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95.0000  -55.7700  8.44000  4  18 

96.0000  -77.4000  10.2800  4  19 

97.0000  -108.040  11.9500  4  20 

8904 10  133634  4 


70  00 

72.0000  -6.35000 
74.0000  -9.53000 
76.0000  -6.80000 
77.0000  -16.9300 
78.0000  -27.6200 
79.0000  -33.6400 
80.0000  -32.9700 
81.00)0  -35.4100 
83.0000  -36.7700 
84.0000  -29. 1900 
85.0000  -20.2900 
86.aX)0  13.4400 
87.0000  25.3500 
88.0000  26.2500 
89.0000  30.1300 
90.0000  31.1700 
91.0000  20.0600 
92.0000  8.24000 
93.0000  -3.28000 
94.0000  -23.2200 
95.0000  -53.6100 
96.0000  -63.6800 
97.0000  -66. 1900 


■3.43 

2.38000 

5 

5.67 

1 

4.85000 

5 

2 

1.66000 

5 

3 

4.06000 

5 

4 

4.25000 

5 

5 

3.05000 

5 

6 

3.25000 

5 

7 

4.64000 

5 

8 

2.04000 

5 

9 

6.00000 

5 

10 

8. 17000 

5 

11 

9.03000 

5 

12 

7.82000 

5 

13 

8. 15000 

5 

14 

9.97000 

5 

15 

9  20000 

5 

16 

8. 10000 

5 

17 

7  27000 

5 

18 

8.87000 

5 

19 

8.61000 

5 

20 

9.86000 

5 

21 

10.2000 

5 

22 

10.2400 

5 

23 

5 


393 
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890410  140648  2  5  30 


?0 

00 

-5 . 49 

10  ‘ 

72  OOOiO 

12.2500 

8.  111300 

6 

1 

73 . 0000 

14.3700 

6 . 40000 

6 

2 

74 . 0000 

18  1700 

4  60000 

6 

3 

78.0000 

34  7500 

7.04000 

6 

4 

79 . 0000 

39  59(X;i 

9.02000 

6 

5 

SO  0000 

37.7000 

6  16000 

6 

6 

8 1 . 0000 

33 . 3800 

4 . 070a'i 

6 

1 

82 .  OCCiO 

36.0800 

4  4'jiOCiO 

6 

8 

83.0000 

55.75013 

13.9500 

6 

9 

84.0000 

59.5400 

1 1 . 1200 

6 

10 

85.0000 

58  1100 

8  76000 

6 

11 

86.0000 

48.3900 

7.57000 

6 

12 

87.0000 

53.0300 

9.82000 

6 

13 

98.0000 

36  7200 

9.47000 

6 

14 

39.0000 

19.7800 

6  70000 

6 

15 

90 . 0000 

12.6800 

6.68000 

6 

16 

91.0000 

-4.30000 

7.44000 

6 

17 

92.0000 

-13.9100 

8.27000 

6 

18 

93.0000 

-22.8200 

11.2500 

6 

19 

94.0000 

-22. 1900 

9.23030 

6 

20 

95.0000 

22.9000 

8.70000 

6 

21 

96.0000 

-14.7000 

12.2700 

6 

22 

INTEROflL  ACCEPTED 


e  393"^ 


flZItIUTH 

OUTPUT 

96 . 0 

-14.35 

26.04 

95.0 

-1.67 

22.97 

94.0 

-2.60 

13.46 

93.0 

4. 49 

10.  10 

92.0 

5.e.6 

10.  17 

91.0 

15.73 

11.49 

90  0 

24.21 

17.06 

89.0 

28.27 

13.91 

88.0 

31.20 

13.42 

87.0 

17.91 

16.06 

86.0 

5.03 

13.32 

85.0 

-27.27 

18.  11 

84.0 

-35.08 

9,57 

83.0 

-32.23 

7.59 

82.0 

-24.43 

11.61 

81.0 

-19.38 

8.00 

80.0 

-18.98 

6,92 

79.0 

-20.27 

8.45 

78.0 

-17.06 

7.94 

77  0 

-15.66 

11,07 

76.0 

-4.77 

4.08 

75.0 

-7.90 

6.56 

74.0 

-14.22 

5.59 

73.0 

3.53 

12.02 

I 
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303'"  AZIMUTH  OUTPIIT 


78.0 

33  08 

9  02 

79.0 

36.28 

n.93 

a).o 

38  50 

8.74 

81.0 

39.02 

12.24 

82.0 

38.65 

9.65 

83.0 

45.44 

22.  13 

84.0 

46.51 

23.54 

85  0 

56  99 

13  27 

86  0 

48.68 

13.24 

87.0 

55.22 

14.64 

88  0 

39  24 

15.89 

89.0 

27.98 

17.29 

90.0 

6.84 

14.75 

91.0 

-11.64 

16.21 

92  0 

-28.76 

24.66 

93.0 

-34  31 

22.25 

94.0 

-35.96 

23.49 

95.0 

-33.83 

21. 16 

96.0 

-38.38 

37.85 

28  19 
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• 

NS  WCi  EU 

COMPOfCMTS 

EftRLV  NS,. 

EU  UlMO 

• 

HEIGHT 

'JEU  EFiREU 

UMS 

ERRMS 

75  0 

-29.0 

4  9 

9.4 

4.8 

76  0 

-30  9 

5,2 

14.4 

4.6 

77.0 

-36.  1 

5  5 

4  7 

4.6 

• 

78  0 

-35.6 

4,7 

2.8 

4.  1 

79.0 

-38  7 

5,6 

10 

4  5 

SO.O 

-43.3 

5.4 

5.5 

4.3 

81.0 

-48.0 

7  2 

8. 1 

5.3 

82.0 

-47.9 

6.9 

2.0 

5.4 

33.0 

-47.0 

8.2 

-7.9 

6.8 

# 

84.0 

-47.2 

8.9 

-11.2 

7.9 

85.0 

-61.7 

9.2 

7.6 

8.3 

86  0 

-38.3 

10.4 

30.9 

9.8 

87.0 

-38.4 

10.4 

46.3 

10.3 

88.0 

-18  0 

11.4 

48.9 

10.  1 

89.0 

-15.0 

10.  1 

43.4 

9.0 

90.0 

12.3 

9.4 

20.8 

8.  1 

• 

91.0 

24.5 

9. 1 

2.9 

7.7 

92.0 

39.7 

9. 1 

-19.0 

7.8 

93.0 

40.9 

9.3 

-21.2 

7.8 

94.0 

40.3 

8.9 

-29.3 

8.2 

95.0 

36.6 

10.6 

-25.8 

9.  1 

• 

LATE  MS, 

EU  Uim 

# 

HEIGHT 

UEU  ERF1EU 

UMS 

ERRMS 

72.0 

-13.7 

10.6 

1.3 

9.  1 

74.0 

-20.4 

10.  t 

1.9 

9.  1 

# 

78.0 

-44.2 

10.6 

-4.2 

9.  1 

79.0 

-51.5 

10.6 

-6.7 

9.  1 

80.0 

-49.6 

10.6 

-7. 1 

9.  1 

81.0 

-47.3 

10.6 

-115 

9. 1 

83.0 

-66.8 

10.6 

-.5 

9. 1 

84.0 

-65.8 

10.6 

7.9 

9.  1 

85.0 

-59.8 

10.6 

14  6 

9.  1 

• 

86.0 

-33.3 

10.6 

37.6 

9.  1 

87.0 

-30.7 

10.6 

50. 1 

9.  1 

88.0 

-16.5 

10.6 

42.0 

9.  1 

89.0 

-.2 

10.6 

36.0 

9.  1 

90  0 

6.3 

10.6 

33.0 

9.  1 

91.0 

14.5 

10.6 

14.5 

9.  1 

• 

92.0 

16.2 

10.6 

-.7 

9.  1 

93,0 

17.4 

10.6 

-15.2 

9.  1 

94.0 

6.0 

10.6 

-31.6 

9.1 

95.0 

-10.0 

10.6 

-57.4 

9.  1 

• 
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HEIGHT 

LIEU 

ERREW 

UNS 

ERRNS 

96.0 

24.4 

34  8 

-32  9 

30.0 

95  0 

27.5 

217 

-19.8 

22  4 

94 . 0 

28.7 

21.0 

-21.8 

17  1 

93.0 

31.2 

19.5 

-14.9 

14.8 

92.0 

27.2 

21.4 

-10  9 

15.9 

91  0 

18  3 

15.0 

6.9 

13  1 

90.0 

7  4 

15.5 

24  0 

16  4 

89.0 

-8.  1 

16.4 

39.0 

15.0 

38.0 

-15.9 

15.2 

47.5 

14.2 

87.0 

-36  6 

15  1 

45  1 

15.6 

86.0 

-38.  1 

13.3 

30.7 

13  3 

35.0 

-62.7 

14.9 

8.2 

16.8 

34. 0 

-58.  1 

20.4 

-4.  1 

15.  1 

83.0 

-55.7 

19.0 

-2.3 

13  6 

82.0 

-45.7 

10.3 

.6 

11.1 

81.0 

-43.3 

11.1 

5.0 

9.5 

80.0 

-42.6 

8  2 

5.  1 

7.5 

79.0 

-41.5 

11.0 

2.8 

9.6 

78.0 

-37.0 

8.7 

3.7 

8.3 

I  SR  PROCESS  I  MG  COrVLETED 
GET  GROUES  UELXITIES,  ERRORS 
EMTER  T  FOR  TIDE,  G  FOR  GROOUT  INPUT 


ACCESSING  FILE  t1flXT0R6O0; IDIGNSEW:890410TIC€ 
TIDAL  WINDS  CXCULftTEO 

DETERMINE  101  UlhOS 

ENTER  FIRST  SPP  -  GR  FILE  NL»®ER 
239 
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IQj  |  PRQF  I  LE  ***^** 


IMFILE  =  nfiXTOReOO  iriFILES  ;SFT>  -  GR  239 

-Qyy  99.  4.  1u  10.  45  36  600  -QQO 

OUTFILE  =  riflXT0R600;0LITFILES;CI4i01214.MflU 


ALT 

U 

0 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

INTERCEPT 

INFILE 

=  NAXT0R600: 

INFILES 

SPP  - 

-  GR  240 

-999. 

89. 

4. 

10. 

12. 

19 

40 

965  -9< 

69. 

5.2 

-11.4 

0.0 

117.6 

671 

479 

124 

33  5 

.  1 

1.5 

72. 

-13.9 

-6  5 

0.0 

119.2 

697 

470 

130 

34.8 

.  1 

1.3 

75. 

-24.8 

5.  1 

0.0 

122.2 

644 

365 

172 

32.2 

1 

14 

78. 

-34.3 

3.4 

.  1 

124.4 

762 

373 

267 

38.  1 

.  1 

1.7 

81. 

-46.4 

13.  1 

.2 

126.6 

829 

295 

352 

41.5 

.  1 

2.3 

84. 

-50  2 

28.3 

.  ^ 

130.3 

1129 

442 

622 

56.5 

.2 

3.3 

87. 

-21.7 

37.0 

-.5 

137.  1 

1164 

380 

763 

58.2 

.3 

4.2 

90. 

28  2 

14. 1 

-1.2 

140.3 

798 

214 

520 

39.9 

0.0 

7  6 

93. 

43.  1 

6.8 

0.0 

137.7 

505 

111 

340 

25.3 

.2 

4.7 

96. 

48.9 

1.  1 

-.4 

154.2 

399 

196 

209 

20.0 

.2 

5.3 

99. 

29.3 

-4.2 

-.2 

167.8 

668 

535 

241 

33.4 

0.0 

6.2 

102 

23.9 

3.9 

-.  1 

169  0 

904 

708 

333 

45.2 

.  1 

5.9 

105. 

32.8 

-19.5 

-.6 

165.8 

892 

640 

374 

44.6 

.3 

4.5 

108. 

39.2 

-40.4 

-.8 

154.7 

480 

281 

222 

24.0 

0.0 

6.6 

111. 

65.5 

-9.5 

.  1 

127.3 

174 

99 

67 

8.7 

.6 

3.0 

FCJECTIOMS. 

•JMflX  OFNO  UraiflX  POLRR 
2243  0  0  2357 

INFILE  *  fIflXTOFfiOO:  INF1L£S:SPP  -  GR  239 

-999.  39.  4.  to.  10.  45.  36.  600.  -999. 

OUTFILE  =  t1flXT0R6O0:0UTFILES:04101214.MfiM 


ALT 

U 

U 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

INTERCEPT 

INFILE 

1 

II 

NFILES 

SPP  - 

OR  240 

-999. 

89. 

4. 

10 

12. 

19 

40. 

965.  -9< 

70. 

1.  1 

-10.  1 

-.  1 

118.3 

689 

370 

208 

34.5 

.  1 

1.8 

73. 

-17.5 

-2.7 

0.0 

120.0 

726 

337 

232 

36.3 

.  1 

1.6 

76. 

-28.2 

5.5 

.3 

122.7 

660 

331 

296 

33.0 

.  1 

1.6 

79. 

-37.6 

4.8 

.5 

125.2 

805 

372 

401 

40.3 

.  1 

1.7 

82. 

-53.7 

20.0 

1.0 

127.2 

917 

278 

552 

45.8 

.  1 

2.6 

85. 

-40.7 

39.6 

-.1 

132.9 

1199 

371 

806 

60.0 

.  1 

4.9 

88. 

-3.3 

23.9 

-.6 

138.9 

1090 

328 

745 

54.5 

.2 

6.4 

91. 

41.5 

13. 1 

-1.9 

139.6 

718 

175 

498 

35.9 

-.  1 

7.2 

94. 

31.1 

16.7 

.  1 

137.3 

404 

84 

300 

20.2 

.6 

3.6 

97. 

50.  1 

3.0 

-.6 

154.7 

342 

172 

190 

17.  1 

.2 

4.9 

100. 

27.6 

-1.3 

-  3 

167.8 

705 

522 

312 

35.3 

.2 

4.7 

103. 

26.3 

-5.6 

-.2 

169.0 

944 

683 

442 

47.2 

-.  1 

7. 1 

106. 

38.4 

-22.6 

-.9 

165.8 

860 

598 

398 

43.0 

.2 

5.4 

IU9. 

42.6 

-37.2 

-1.1 

154.7 

446 

277 

231 

22.3 

.4 

4.6 

REJECTIONS: 

UMAX  '.Et=0  URMflX  POLAR 
2158  0  0  2226 


-999 


-999 


-999 


-999 
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INFILE  =  MflXTOFteOO 
-■W’h  o9 


INFILES:SFP  - 
4  10. 


GR  239 

to. 


45 


bOO 


-999 


-999 


niJTFILE  =  MH.XT0Re.OO:0UTFILES:O41Ot214  HflU 


HLT 

U 

U 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

INTERCEPT 

INFILE 

=  NH.XT0R600 

NFILE3 

:SPP 

-  GR  240 

-999 

89. 

4 

10 

12 

19 

40. 

965  -999 

71 

-3.9 

-8  0 

0  0 

118.7 

688 

379 

273 

34.4 

.  1 

1.4 

74. 

-21.7 

1.8 

. 

121.6 

619 

332 

^  1  1 

31.0 

0.0 

1.9 

77 

-32 . 6 

4  9 

.5 

124  2 

750 

358 

393 

37.5 

1 

1.5 

80. 

-43 .  1 

5.5 

1.0 

125.9 

772 

281 

448 

38.6 

1 

19 

83. 

-56  0 

24.2 

.  1 

128.8 

1110 

360 

715 

55  5 

.  ^ 

2.8 

86. 

.  -•» 

45.  1 

-.6 

136.3 

1144 

324 

795 

57.2 

.2 

4  5 

89. 

18  1 

16.  1 

-1.7 

140.4 

845 

175 

575 

42.2 

,  1 

6  9 

92. 

44. 1 

7  5 

.  1 

137.9 

569 

83 

408 

28.5 

1 

5.2 

95. 

37.5 

8.3 

_  -j 
.  1 

154.  1 

431 

153 

277 

21.5 

.3 

4  9 

98 

40.7 

-3.6 

- .  3 

167  8 

675 

509 

283 

33.8 

_  ^ 

5.5 

101. 

21.6 

-.2 

-.3 

169.0 

891 

673 

401 

44  5 

.  1 

5.4 

104. 

28.5 

-13.8 

-.7 

165.8 

880 

575 

467 

44.0 

.  1 

5.6 

107. 

38.5 

-39.0 

-1.3 

154.7 

503 

283 

272 

25.  1 

0.0 

6  4 

no. 

45.6 

-18.6 

-.9 

127.4 

171 

82 

97 

8.6 

.3 

6.0 

REJECTIONS: 

UWiX  0R=0  IJmflX  POLftR 
1879  0  0  1877 

REORDERING  FILES  BV  DESCEICirftJ  HEIGHTS 
SUCCESSFUL  RUN 

*****  ERROR  CRLCLM-RTION  -  PflSS  1  ***** 


INFILE  =  nflXT0R600: lhFlLES:SPP  -  239 

-999.  89  4.  10.  10. 


45. 


36. 


600. 


-999.  -999. 


OUTFILE  =  MflXT0R600:0UTFILES:04101239.nflU 


«.T 

INFILE 

U  U 

=  riflXT0R600: 

U 

irriLES 

TRP 
:SPP  - 

NTOT  NPU 
-  GR  240 

RATE 

SLOPE 

INTEACEPT 

-999. 

89 

4. 

10. 

12. 

19 

40. 

965.  -9< 

69. 

1.0 

-8.2 

0.0 

117.6 

696 

400 

327 

27.8 

.  1 

1.7 

72. 

-17.4 

-1.3 

.4 

120.2 

741 

404 

354 

29.6 

.  1 

1.8 

75. 

-29.  1 

6.3 

.7 

122.9 

742 

306 

438 

29.7 

1 

1.5 

78. 

-41.4 

4.9 

.8 

125.3 

939 

320 

588 

37.6 

.  1 

1.7 

81. 

-56.0 

14.4 

.9 

127.2 

1003 

262 

661 

40.  1 

.2 

2.2 

84. 

-52.7 

28. 1 

.2 

130.9 

1370 

391 

941 

54.8 

.  1 

4.  1 

87. 

-27.4 

34.4 

-.8 

136.9 

1250 

314 

921 

50.0 

.3 

4.5 

90. 

16.5 

17.3 

-1.4 

139.5 

781 

177 

594 

31.2 

0.0 

6.8 

93. 

47.0 

3.7 

-.2 

138. 1 

405 

94 

332 

16.2 

3.7 

96. 

30.7 

4.7 

-.6 

162.  1 

765 

519 

376 

30.6 

- .  3 

8.7 

99. 

22.9 

-9.3 

-.5 

172.5 

1093 

890 

401 

43.7 

-.3 

8.2 

102. 

14.0 

-30.  1 

-.2 

170.8 

1229 

887 

536 

49.2 

.  1 

6.0 

105. 

26.3 

-30.8 

-.7 

159.0 

971 

507 

619 

38.8 

.4 

5.2 

108. 

51.8 

-5.3 

-.5 

133.7 

214 

49 

132 

8.6 

0.0 

6.4 

111. 

37.2 

9.4 

.8 

131.5 

198 

65 

93 

7.9 

.5 

3.7 

REJECTIONS: 

UMAX  UR^3  URMflX  POLAR 
2273  0  0  2293 


-999. 


220 


Itff'lLE  =  t1f!XT0R6O0  I MF I LES :  SPP  -  Gft  23^ 
-<399  39  4  10.  10. 

ClUTFILE  =  MflXTOR600  ;OUTFILES  ;04101239  MfiW 


45 


ALT 

U 

U 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

1  NTEi 

INFILE 

=  NRXTORbOO 

11^1 

LES 

:SPP  - 

GR  240 

-999 

39. 

4 

10 

12 

19 

40. 

965 

70 

-.4 

-7.9 

- 

118.4 

707 

381 

362 

28  3 

.  1 

19 

73. 

-13.7 

1.2 

.5 

120  6 

786 

395 

397 

31.4 

0-0 

2.4 

76. 

-30.9 

8.  1 

123-5 

807 

278 

485 

32.3 

.  1 

1  6 

79 

-45.6 

5.2 

.8 

126.2 

968 

289 

629 

38.7 

1 

1.9 

82 

-58  9 

18.4 

1 

.  ^ 

128.4 

1122 

236 

759 

44.9 

2  1 

85. 

-47.7 

33.  1 

133.  1 

1423 

377 

1003 

56.9 

1 

4  8 

88. 

-11.8 

27.6 

- 

.9 

138.0 

1117 

309 

795 

44.7 

.  1 

6  0 

91. 

32.6 

12  5 

-1 

.4 

139.4 

646 

169 

512 

25  8 

0  0 

5.8 

94. 

37.8 

3.4 

- 

.  1 

140.3 

348 

90 

280 

13.9 

2 

5.  1 

97. 

35.4 

8.5 

- 

f 

. 

162.3 

721 

500 

359 

28.8 

-  5 

10.0 

100. 

18.7 

-10.0 

- 

.4 

172.5 

1132 

886 

454 

45.3 

-.  1 

6.5 

103. 

10.9 

-35.5 

- 

1 

170.8 

1366 

885 

679 

54.6 

1 

6.5 

106. 

39.0 

-23.6 

- 

8 

158  9 

811 

494 

499 

32.4 

.3 

5  8 

109. 

40.6 

5.8 

.5 

132.8 

202 

39 

114 

8.  1 

.  ^ 

4.9 

REJECTIONS: 

UNfiX  UR=0 

2207  0 

INFILE  =  NflXTOReOO: 
-999.  39. 


URttflX  POLAR 

0  2180 

NFILES:SPP  -  GR  239 
4.  10.  10. 


600  -9'9'3 


-‘999 


45. 


36. 


600.  -999. 


OUTFILE  =  MRXT0R600:0UTFILES:04101239.MflU 
ALT  U  U  M  TRP  NTOT  rff>U 

Ilf^lLE  =  NAXT0R6OO; INFILES ;SPP  -  (X  240 


NPH  RATE  SLOPE  INTERCEPT 


-999. 

89. 

4. 

10. 

12. 

19 

40. 

965. 

71. 

-4.0 

-6.5 

.  1 

119.9 

712 

374 

387 

28.5 

.  1 

1.6 

74. 

-21 . 1 

2.8 

6 

122.5 

715 

323 

412 

28.6 

0.0 

2.2 

77. 

-34.7 

8.6 

.7 

125.0 

913 

297 

588 

36.5 

.  1 

1.7 

80. 

-50.9 

4.  1 

1.3 

126.0 

928 

262 

584 

37.  1 

.  1 

1.7 

83. 

-61.1 

23.  1 

.3 

129.9 

1342 

383 

897 

53.7 

.  1 

3.7 

86. 

-37.5 

38.5 

-.7 

136.3 

12a3 

318 

937 

51.2 

.2 

4.8 

89. 

4.0 

22.4 

-1.5 

139.6 

831 

181 

613 

33.2 

.  1 

6.4 

92. 

37.8 

3.5 

”  .  ^ 

138. 1 

484 

94 

393 

19.4 

.  1 

4.1 

95. 

33.5 

6.2 

-.7 

162. 1 

786 

512 

413 

31.4 

.  1 

6.7 

98. 

27.7 

-5.2 

-.5 

172,5 

1081 

878 

398 

43.2 

-.5 

9.3 

101. 

14.4 

-21.3 

-.  1 

170.8 

1171 

889 

507 

46.8 

0.0 

6.5 

104. 

16.  1 

-35.4 

-.9 

159.0 

1013 

508 

659 

40.5 

.2 

5.9 

107. 

57.0 

3.2 

-.5 

133.7 

228 

60 

146 

9.  1 

.  1 

6.3 

no. 

36.5 

19.5 

1.6 

131.6 

1^ 

44 

104 

7.8 

.6 

2.7 

-999. 


REACTIONS; 

OIWX  0R=0 

1904  0 

f£OROERIl«  FILES 
SUCCESSFUL  RUN 


URMRX  POLFfi 

0  1816 

BV  DESCENDIW  HEIGHTS 


-999 


-999 


-999 


-999 
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*****  ERROR  CRLCULRTIWI  -  PASS  2  ***** 


INFILE  =  MfiXT0R600: INFILES :SPP  -  GR  239 

-999  89  4  10  10  45  36  600  -999 

OUTFILE  =  f1flXT0R600  OUTF I LES  04101149 


ALT 

U 

U 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

INTERCEPT 

rciLE 

II 

X 

NFILES 

;SPP  - 

■  GR  240 

-999. 

89 

4 

10. 

12 

19 

40. 

9ti5  -999 

69. 

3.2 

-9.5 

-  1 

122  2 

808 

425 

430 

32  3 

1 

1  6 

72. 

-22  0 

-3  8 

.4 

124  2 

718 

298 

441 

28  7 

1 

1.7 

75. 

-33  2 

2.9 

12 

124.9 

763 

228 

523 

30.5 

.  1 

15 

78. 

-41.7 

3.2 

,9 

125.  1 

819 

262 

494 

32.8 

.  1 

1.6 

81. 

-48.6 

18.6 

8 

126.4 

999 

294 

645 

40.0 

2 

2.3 

84. 

-41.8 

28.2 

0.0 

128  9 

1237 

325 

7« 

49  5 

.  1 

4  1 

87. 

-15.6 

27  6 

-  8 

135.7 

1457 

393 

923 

58.3 

r> 

4.5 

90. 

41.7 

6  5 

-1.0 

139.6 

1042 

208 

673 

41.7 

-.  1 

5  7 

93. 

49.2 

5.8 

-.6 

136.3 

700 

115 

471 

28.0 

.2 

4  6 

96. 

62.  1 

5.6 

-  1 

133.5 

396 

109 

262 

15.8 

.4 

4.2 

99. 

59.  1 

-7.0 

0.0 

157.  1 

551 

306 

316 

22.0 

0  0 

7  1 

102. 

9.2 

-16.6 

-.  1 

169.  1 

1129 

821 

521 

45.2 

-.2 

9.4 

105. 

32.8 

-27.3 

-.5 

169.6 

1325 

996 

484 

53.0 

0.0 

7.0 

108 

46.  1 

-34.4 

-.9 

159.4 

1180 

741 

582 

47.2 

.4 

5.3 

111. 

53.  1 

-9.7 

0.0 

133.0 

285 

69 

164 

11.4 

.4 

3.8 

REJECTIONS; 

UMAX  UR=0  URtIflX  POLf« 

2567  0  0  2663 

INFILE  =  MflXT0R600;  INFILES -  Gfi  239 

-999.  89.  4.  10.  10.  43.  36.  600  -999. 


-999 


-999 


-999 


OUTFILE  =  mXTOR600;OUTFILES:04101149.f1flU 
ALT  U  U  U  TRP  NTOT  NPV  rff>H  RATE  SLOPE  INTERCEPT 

IHFILE  =  f1RXT0R600. IHFILES;SPP  -  OR  240 


-999. 

89. 

4 

10, 

12. 

19 

40. 

965, 

70. 

1 

2 

-V.G 

- 

.2 

122 

.6 

828 

391 

471 

33 

1 

.  1 

1 

8 

73. 

-24 

2 

-4.5 

.6 

124 

.9 

762 

287 

466 

30. 

5 

,  1 

1 

6 

76. 

-31 

8 

4.0 

1 

.2 

125 

.0 

754 

225 

511 

30 

.2 

.  1 

1 

9 

79. 

-39 

.3 

3.2 

.8 

125 

.2 

879 

275 

537 

35 

2 

.  1 

1 

6 

82. 

-47 

.8 

16.0 

.9 

127 

.0 

1051 

308 

641 

42 

0 

.2 

1 

9 

85 

-36 

7 

33.4 

2 

131 

.  1 

1360 

310 

883 

54 

4 

.2 

3 

8 

88. 

4 

.9 

18.7 

- 

.7 

137 

.7 

1365 

385 

852 

54 

6 

.  1 

6 

1 

91. 

48 

.2 

6.2 

-1 

.  1 

139 

.2 

993 

194 

626 

39 

7  - 

.  1 

5 

5 

94 

54 

7 

5.5 

- 

.2 

134 

.8 

581 

83 

405 

23, 

2 

.3 

4 

4 

97. 

53 

.  1 

o 

.  V 

1 

.  1 

137 

o 

. 

367 

47 

301 

14 

-? 

.  f 

.4 

4 

1 

100. 

30 

.7 

-9.  1 

.3 

157 

.2 

508 

299 

269 

20 

.3  - 

.  1 

8 

0 

103. 

25 

.7 

-9.0 

- 

.  1 

169 

,  1 

1101 

883 

427 

44 

0  - 

.3 

8 

1 

-999 


106.  31.6  -34.3  -.5  169.6  1417  1029  537 

109.  51.8  -24.5  -1.0  159.4  1120  777  592 

REJECTIONS: 

UNAX  UR=0  URNAX  POLf« 

2473  0  0  2513 


56.7 

44.8 


.2  5.2 

.2  7.  1 
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IMFILE  =  liflXTOReOO 
-9'39  89 . 


INFILES  SPP  -  Gft  239 
4  10.  to 


45 


36 


6(KI 


ClUTFILE  =  MflXT0R6O0:0UTFILES:041OII49  ftfW 


ALT 

IJ 

U 

U 

TRP 

NTOT 

NPU 

NPH 

RATE 

SLOPE 

IHTEI 

INFILE 

=  MflXTWieOO: 

INFILES 

:SPF  - 

-  GR  240 

-999 

89. 

4. 

10 

12 

19 

40 

965. 

71. 

-8.  1 

-11.7 

.  1 

124.  u 

706 

279 

440 

28.2 

1 

16 

74 

-28  6 

-3  1 

1  1 

124.8 

740 

255 

475 

29  6 

0  0 

2  2 

1  f  . 

-34 . 4 

4  6 

.9 

124.8 

814 

264 

524 

32  6 

0.0 

2  1 

80 

-?9  ■’ 

3.7 

Q 

125.6 

970 

310 

605 

38.8 

1 

1.8 

83. 

-49  3 

20.3 

6 

127.6 

1160 

332 

698 

46  4 

.2 

2  2 

86. 

-29.3 

38.0 

-.7 

134.4 

1408 

380 

915 

56  3 

1 

4.8 

89. 

30.4 

7.4 

-10 

139.7 

1079 

200 

680 

43.2 

0.0 

6.3 

92. 

48.7 

2.4 

0.0 

137.  1 

780 

81 

505 

31.2 

0.0 

4  1 

95. 

56  9 

6.3 

1.2 

132.4 

452 

42 

320 

18.  1 

5 

3.  1 

98. 

58.4 

-4.9 

.  1 

157.  1 

592 

286 

360 

23.7 

3 

5  5 

101 

18  2 

-9  7 

-  1 

169.  1 

1130 

850 

496 

45.2 

•  .  ^ 

9.2 

104. 

21.4 

-24.7 

-.3 

169  6 

1292 

1052 

444 

51.7 

.  ^ 

7.8 

107. 

41.5 

-31.6 

-.8 

159.4 

1192 

785 

588 

47.7 

3 

5.  1 

110. 

60.2 

-37.2 

-.8 

133.  I 

295 

125 

212 

118 

.9 

1.9 

REJECTIONS. 

UMAX  UR=0 

URNflX 

POLAR 

2224 


2178 


REORDERING  FILES  BV  DESCENDING  HEIGHTS 
SUCCESSFUL  RUN 

ALL  DOI€.  CR  TO  EXIT 


-999 


-999 


-999 


9?9 
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C  PROGRAM  ISRIDIIDIG 

C  JULY  14.  1993 

C  USES  SUBROUTINES  BASED  ON  IDIGNSEW.  IDIWIND  AND  ISRNSEW 

C  TO  PRODUCE  FILE  "IIZCRKPLOT '  TO  BE  IMPORTED  AND 

C  GRAPHED  BY  CRICKETGRAPH  (SEE  MANUAL  FOR  DETAILS) 

C  ACCESSES  SUBROUTINES 

C  FOR  INPUT  TIMING 

C 

c 

C  FOR  I SR  PROFILES 

C 

c 
c 
c 
c 
c 

C  FOR  GROVES  PROFILES 

C 

c 
c 

c  FOR  IDI  PROFILES 

C 
C 
C 
c 
C 

c 
c 
C 

c 

C  AND  SETS  UP  OUTPUT 

c 
c 

CHARACTER • 1  ATHERE . C4  H ( 4 ) . DUM ( 3 ) . DUMI N 1 1 1 ) . DUMMY ( 1 0 ) . NEG , TAB . 
•SPACE( 32) , GO. YES. NO. POLAR 
CHARACTER‘4  B{4 3. 31 ) . CH4 . BLANK 
CHARACTER* 10  TUREKTIME 
CHARACTER* 11  CRKPLOT 
CHARACTER* 2 7  INPATH 
CHARACTER* 19  OUTPATH 
CHARACTER* 40  INFILE, OUTFILE 
INTEGER*4  YEAR, MONTH, DAY.HOUR.MINUTE.HOWLONG 
REAL* 4  NINES 

COMMON  /WIHD3/  PI.VMAI.THMAEH.THMINH.THMAXV.THMINV.MINH.MINV. 

1  NS IGMA . TESTFLAG , IH . NPOINTS | 50 ) . INFI LE , OUTFILE . INPATH . 

2  OUTPATH . NPH . NPV , NPVO . SLOPE . INTERCEPT . FITFLAG 
COMMON  /HSKP/  ATHERE, DUM, DUMIN 

COMMON  /ARRAYS/  A(43,33),B 
COMMON  /SPPFILE/  IFILE.NFILE, POLAR 

COMMON  /TIMER/  INTNUM, YEAR. MONTH. DAY, HOUR. MINUTE, TUREKTIME. 
*HOWLONG.NOW 

EQUIVALENCE  (IDIDATA. DUMIN) .( ISRDATA. DUMIN) . 

*( CRKPLOT . DUMIN ),{ CH4 . C4H ).( TUREKTIME , DUMMY ) 

WRITE  (*,*)  ■■  PROGRAM  ISRIDIIDIG" 

WRITE  {*,*)  ••  '• 

BLANK=' 


TIMED 

INTERVAL 

NSEWISR 

RADIAL 

NORMAL 

PERP 

NSEWl 

NSEW2 

GNSEWIDI 

GPROFl 

GPROF2 

SUBVERT 

NSEWIDI 

IDI 

SUBVERT 

INNAME 

OUTNAME 

WFV 

WFH 

PHFIT 

REORDER 

DEVIANT 


00000001 

00000002 

00000003 

00000004 

00000005 

00000006 

00000007 

00000008 

00000009 

00000010 

00000011 

00000012 

00000013 

00000014 

00000016 

00000016 

00000017 

00000018 

00000019 

00000020 

00000021 

00000022 

00000023 

00000024 

00000025 

00000026 

00000027 

00000028 

00000029 

00000030 

00000031 

00000032 

00000033 

00000034 

00000035 

00000036 

00000037 

00000038 

00000039 

00000040 

00000041 

00000042 

00000043 

00000044 

00000045 

00000046 

00000047 

00000048 

00000049 

00000050 

00000051 

00000052 

00000053 

00000054 

00000055 

00000056 

00000057 

00000058 
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NEG=  - 
TaB=CHAR i 9 ; 
YES=Y" 
NO=N" 
ATHERE=  '9 
NINES=999.0 
DO  1  1=1.32 
SPACE ( I !=TAB 

1  CONTINUE 

DO  2  1  =  1.43 
DO  2  J-i.33 
A(I.J)=NINES 

2  CONTINUE 


•  COMMUNICATE  WITH  USER 


3  WRITE  (*.•)  '  ENTER  TUREK  INTERVAL  NUMBER- 

WRITE  (•■•)  ■  (THREE  FIGURES.  WITH  LEADING  ZERO(ES))- 
WRITE  ( • .  • )  "  " 

READ  (•.•(3A1)”)  DUM 

INTNUM=100*(ICHAR(DUM( 1) )-48t+ 10* ( ICHAR(DUM( 2) )-48) ♦ 
•ICHAR(DUM( 3) )-48 
DO  4  1=1, 3 
DUMIN(I)=DUM(I) 

4  CONTINUE 
CALL  TIMED 

WRITE  (•.*)  IHTNUM.  ■  CORRESPONDS  TO  DATE/TIME  '.TUREKTIME 
WRITE  (*.•)  "  " 

WRITE  (•.•)  ■■  IF  CORRECT  ENTER  Y.  IF  INCORRECT,  ENTER  N’ 
WRITE  (•■•)  ■■ 

WRITE  (V)  ■  (OR  ENTER  ANY  OTHER  KEY  TO  EXIT)" 

READ  (•.-•(Al)")  GO 

IF  (OO.EO.YES)  GO  TO  5 

IF  (GO.EO.NO)  GO  TO  3 

IF  (GO.NE.YES.OR.GO.NE.NO)  THEN 

WRITE  ( • . • )  "  CHECK  TUREK  INTERVAL  NUMBER- 

PAUSE 

STOP 

END  IF 

SET  UP  ARRAY  SEGMENT  A(I, 14-31)  FROM  FILE  ISR. DATA. SCENE. 3.4 

5  CALL  NSEWISR 

DETERMINE  INTERVAL  AS  PROCESSED  BY  NSEWISR 
CALL  INTERVAL 

SET  UP  ARRAY  SEGMENT  A( 1,2-7)  FROM  "XIXXTIDE”  (GROVES  OUTPUT) 
CALL  GNSEWIDI 

SET  UP  ARRAY  SEGMENT  A(I,8-13|  FROM  SPP  FILE 
CALL  NSEWIDI 

CALCULATE  IDI  AND  ISR  NS  AND  EW  DIFFERENCES 


00000059 

00000060 

00000061 

00000062 

00000063 

00000064 

00000065 

00000066 

00000067 

0C000068 

00000069 

00000070 

OOOOOOTl 

00000072 

00000073 

00000074 

00000075 

00000076 

00000077 

00000078 

00000079 

00000080 

00000081 

00000082 

00000083 

00000084 

00000085 

00000086 

00000087 

00000088 

00000089 

00000090 

00000091 

00000092 

00000093 

00000094 

00000095 

00000096 

00000097 

00000098 

00000099 

00000100 

00000101 

00000102 

00000103 

00000104 

00000105 

00000106 

00000107 

00000108 

00000109 

00000110 

00000111 

00000112 

00000113 

00000114 

00000115 

00000116 
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CALL  DEVIANT 

OUTPUT  FILE  "XXXCRKPLOT" 

CRKPLOT="  CRKPLOT  " 

DO  7  1  =  1.3 
DUMIN(I)=DUM(I) 

7  CONTINUE 

OPEN  ( 26. FI LE=CRKPLOT. FORM=' FORMATTED" ) 

WRITE  (26.101)  SPACE 

101  FORMAT  ("  HEIGHT  (KM) " . Al. “IDIG  EW" .Al. "ERR" .Al. "IDIG  NS'.Al. 
•"ERR-.Al. "IDIG  W".A1."ERR",A1."IDI  EW" . Al. "ERR" . Al . "IDI  NS". 

•Al. "ERR".A1. "IDI  W.Al. "ERR-.Al. “ISR  EW" . Al. "ERR" . Al . "ISR  NS". 
•Al. "ERR'.Al. "EW  IDI-ISR-.Al. "NS  IDI-ISR". 

• Al . “VRG" . Al . "ERR" . Al . " VPG" . Al , "ERR" , Al . "VRIDI " , Al . " ERR" , Al , " VPIDI 
• . Al . "ERR" . Al . " VRISR" . Al . "ERR" . Al . "VPISR" . Al , " ERR" , Al . “ EW  IDI" . Al . 
•NS  IDI") 

SET  UP  CHARACTER  ARRAY  B(43.33)  FOR  PRINTING 

DO  45  1=1.43 
DO  45  J=1.33 

IF  (Ad.  J)  .EQ. NINES)  THEN 
CH4=BLANK 
GO  TO  44 
END  IF 

SIGN=A(I.  J)/ABS{Add) ) 

IA=ABS{A(I.J) ) 

IF  (lA.EQ.O)  A(I.J)=A(I.J)d.O 

lAlOO-IA/ 100 

IA10=IA/10-10*IA100 

IA1=IA-100*IA100-10*IA10 

C4H(1)=BLAHK 

C4H(2)=CHAR(IA100*48) 

IF  (lAlOO.EO.O)  C4H(2)=BLANK 
C4H(3)=CHAR(IA10+48) 

C4H{4)=CHAR{IAl+48) 

IF  (J.EO.l)  GO  TO  42 
IF  (C4H{2) .NE. BLANK)  GO  TO  42 
IF  (lAlO.EQ.O)  C4H(3)=BLANK 

42  IF  (SIGN. GT. 0.0)  GO  TO  44 
DO  43  K=3. l.-l 

IF  (C4H(K) .NE. BLANK)  GO  TO  43 

C4H(K)=NEG 

GO  TO  44 

43  CONTINUE 

44  B(I.J)=CH4 

45  CONTINUE 

DO  51  1=1,43 

WRITE  (26.501)  B( I , 1) , (TAB. B{ I . J ) . J=2. 33) 

501  FORMAT  ( A4 . 32( Al. A4 ) ) 

51  CONTINUE 

PAUSE  "  ALL  DONE.  CR  TO  EXIT" 

CLOSE  (26) 

STOP 

END 

SUBROUTINE  TIMED 
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00000136 
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00000138 
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00000140 

00000141 

00000142 

00000143 

00000144 

00000145 

00000146 

00000147 

00000148 

00000149 

00000150 

00000151 

00000152 

00000153 

00000154 

00000155 

00000156 

00000157 

00000158 

00000159 
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00000161 

00000162 
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DETERMINES  TIMES  FOR  USE  IN  CALCULATING  INTERVAL 
FROM  TUREK  NUMBER  XXX  BY  ACCESSING  FILE  •TUREKFILE" 

CHARACTER*!  BLANK, DUMMY ( 10) . FILETIME ( 12 ) 

CHARACTER* 10  TUREKTIME . DUMFILE 

INTEGER* 4  INTNUM , YEAR . MONTH . DAY . HOUR . MINUTE . HOWLONG . NOW . 
*STRT2H0UR, STRT3HOUB, STRT2MIN, STRT311N. 

*  END2HOUR . END3HOUR . END2MIN , END3MIN. A21 . AZ2 


00000175 

00000176 

00000177 

00000178 

00000179 

00000180 

00000181 

00000182 


COMMON  /TIMER/  INTNUM. YEAR . MONTH , DAY. HOlfR , MINUTE . TUREKTIME , HOWLONGOOOOOl 83 


* . NOW . INTHALF . STRT2HOUR . STRT  3HOUR . STRT2MIN , STRT  3MIN . 
•END2HOUR. END3HOUR. END2MIN. END3MIN 
COMMON  /ANGLES/  A21.A22 
EQUIVALENCE  ( DUMFILE . DUMMY ) 

MTIME(M.N)=10*(ICHAR(DUMMY(M))-48)4lCHAR(DUMMY(N) )-48 
BLANK="  " 

OPEN  ( 18. FILE=''MAXTOR600:ISR. DATA; TUREKFILE". STATUS='OLD" 
* FORM=' FORMATTED " ) 

DO  1  1=1.1000 

READ  (18.100.END=6)  NUM. FILETIME. A21 
100  FORMAT  (I5,2X. 12A1. 12X.I3) 

IF  ( NUM. EO. INTNUM)  GO  TO  2 

1  CONTINUE 

2  DO  3  1=1. 6 
DUMMY(I)=FILETIME(I) 

3  CONTINUE 

DUMMY|7)=FILETIME(9) 

DUMMY! 8)=FILETIME( 10) 

DUMMY(9)=FILETIME(11) 

DUMMY(10)=FILETIME(12) 

4  TUREKTIME=DUMF1LE 
DO  5  1=1.10 

IF  (DUMMY(I) .EO.BLANK)  DUMMY{I  )="0" 

5  CONTINUE 


DETERMINE  YEAR.  MONTH.  DAY.  HOUR.  MINUTE 

YEAR=MTIME(1.2) 

MONTH=MTIME(3.4) 

DAY=MTIME(5. 6) 

HOUR=MTIME(7,8) 

MIHUTE=MTIME(9. 10) 

READ  HOURS.  MINUTES  TO  BE  USED  TO  FIND  LENGTH  OF  INTERVAL 

READ  (18.101.END=6)  STRT2HOUR.STRT2MIN.END2HOUR,END2MIN 
101  FORMAT  {15X.2I2.4X.2I2) 

READ  (18,101.END=6)  STRT3H0UR,STRT3MIN.END3H0UR,END3M1N 
CLOSE  (18) 

RETURN 

6  WRITE  ( * .  * )  ■'  DID  NOT  FIND  INTERVAL  -  CHECK  TUREK  FILENUMBER" 
PAUSE 
STOP 
END 

SUBROUTINE  NSEWISR 

MAY  4.  1993 

READS  "MAXTOR600: ISR. DATA: SCENE. $. 4"  FILE  OF  ISR  DATA. 

WITH  APPROPRIATE  FILE  {  $  )  AND  DATA  INTERVAL  BEING 
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00000196 
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00000200 

00000201 

00000202 

00000203 

00000204 

00000205 

00000206 

00000207 

00000208 

00000209 

00000210 

00000211 

00000212 

00000213 

00000214 

00000215 

00000216 

00000217 

00000218 

00000219 

00000220 

00000221 

00000222 

00000223 

00000224 

00000225 

00000226 

00000227 

00000228 

00000229 

00000230 

00000231 

00000232 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CMOS Eli  BY  THE  MOWTM  AND  TUREK  INTERVAL  NlfflDER  ZZX  ENTERED; 

THE  PROGRAM  OUTPUTS  THE  MS  AND  EW  WIND  COMPONENTS, 

TOGETHER  WITH  LINE  OF  SIGHT.  FOR  THE 

CHOSEN  INTERVAL  AT  HEIGHTS  FOR  WHICH  BOTH  QUADRATURE 

COMPONENTS  HAVE  INSTRUMENTAL  ERRORS  WHICH  ARE  <  15  M/S. 

THE  NS  AND  EW  COMPONENTS  ARE  CALCULATED  AS  AVERAGES 
OF  THE  APPROPRIATE  SOUNDINGS,  WITH  ERRORS 
CALCULATED  AS  ONE  SIGMA  OF  THE  DATA  USED. 

IF  THERE  IS  NOT  AN  AVAILABLE  QUADRATURE  COMPONENT 

AT  THE  START  OF  THE  INTERVAL.  BUT  THERE  IS  ONE  AT  THE  END. 

THEN  THE  123*  OR  393*  TUREK  NUMBER  STARTING  THE  INTERVAL 
SHOULD  BE  ENTERED  WHEN  REQUESTED. 

PROGRAM  CAN  ALSO  PROCESS  INDIVIDUAL  PROFILES.  BUT  NO 
NS/EW  COMPONENTS  WILL  RESULT  (OBVIOUSLY!). 

REQUIRES  SUBROUTINES 

MSEWl 

NSEW2 

NORMAL 

PERP 

RADIAL 

CHARACTER* 1  ALPHA1( 3) ,ALPHA2( 3) .BLANK, D( 3) . 

•DUMSTATI 30) .DUMIN( 30) .DUMOUT( 30) .DIMJY( 10) .LINE( 64 ) . 

•TIMES (10). TAB. YES. NO 
CHARACTER* 3  ALPH 1. ALPH 2. AZ. AZIMUTH 
CHARACTER* 10  TUREKTIME . DATTIME 
CHARACTER* 30  INFILE, OUTFILE.STATFILE 
INTEGER*  4  AZ 1 . AZ2 . YEAR . MONTH , DAY . HOUR . MINUTE 
COMMON  /ZPERP/  ZP1( 60) . VP1( 60) .ERP1(60) , 

*  ZP2(60).VP2(60).ERP2(60) 

COMMON  /ZRADIAL/  ZR1( 60) .VR1( 60) .ERR1( 60) . 

*  ZR2(60),VR2(60),EBR2(60). 

*  ZR3(60).VR3(60).ERR3(60). 

*  ZR4(60),VR4(60),ERR4(60) 

COMMON  /ZAP/  ZRO(60),VRO(60).ERRO(60). 

*  ZPO(60),VPO(60),ERPO(60) 

COMMON  /EXTRAS/  ZER0.ALPH1.ALPH2.MB.NP.NMAX.TAB.NAVGE.NPR0FS(6) . 
*COS33,COS57.D 
COMMON  /ARRAYS/  A(43.33) 

COMMON  / TIMER/  INTNUM . YEAR . MONTH , DAY . HOUR , MINUTE , TUREKTIME . 
•HOWLONG.NOW 
COMMON  /ANGLES/  AZ1.AZ2 

EQUIVALENCE  ( ALPHA 1, ALPHl ) . (ALPHA2.ALPH2) . (STATFILE.DUMSTAT) . 

* ( OUTFILE . DUMOUT ) . ( LINE ( 58 ) . AZ ) . ( TIMES . DATTIME ) , 

• ( INFILE . DUMIN ) . ( TUREKTIME . DIWMY ) 

LTIME(M.N)=10*(ICHAR(LINE(M))-48)*ICHAR(LINE(N) )-48 
BLAMK=CHAR( 32) 

ERRNEG=-50.0 
NHAX-0 
ZERO=0 . 0 
RAD=57. 29578 
TAB=CHAR(9) 
yES="Y" 

NO=’'N” 

DO  11  1=1.10 

DUMOUT(I)=BLANK 

DUMSTAT(I)=BLANK 


00000Z33 

00000234 
00000235 
00000236 
00000237 
00000238 
00000239 
00000240 
00000241 
00000242 
00000243 
00000244 
00000245 
00000246 
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00000248 
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00000253 
00000254 
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00000272 
00000273 
00000274 
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00000289 
00000290 
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11  CONTINUE 

DO  12  1=1.60 

ZP1(I1=ZER0 

ZP2iI)=ZERO 

ZRl(I)=ZERO 

ZR2(I)=ZERO 

2R3(I)=ZERO 

2R4(Il=2ERO 

ZPO(I)=ZERO 

ZRO(I)=ZERO 

12  CONTINUE 

WRITE  (•.•)  “  PROCESSING  ISR  DATA" 

SELECT  DATA  SOURCE  FILE 

14  WRITE  {•,*)  ■■  " 

INFILE="MAXTOR600 : ISR . DATA : SCENE .3.4  " 

IF  (MONTH. EO. 3. OR. MONTH. EQ. 4)  DUMIN| 26)="2" 

WRITE  (*,•)  "  " 

OPEN  { 17.FILE=INFILE.STATUS="OLD".FORM="FORMATTED" ) 
LOOK  ANGLE  AZIMUTHS 

SPECIFIC  TO  AIDA' 89  TAKES  CARE  OF  ORIENTATION 

IF  (AZl.EO. 123. OR. AZl. £0.213)  THEN 

A21=213 

A22=123 

END  IF 

IF  (AZl.EO. 303)  AZ2=393 

IF  (AZl.EO. 393)  THEN 

A21=303 

A22=393 

END  IF 

IAZ1=AZ1/100 

JAZ1=AZ1/10-10*IAZ1 

KAZ 1=AZ 1- 100 • lAZ 1- 10* JAZ 1 

ALPHA1(  1)=CUAR(IAZU48) 

ALPHAl ( 2 ) =aiAR ( JAZ1«4 8 ) 

ALPHA1( 3)=CUAR(KAZl448) 

IAZ2=AZ2/ 100 
JAZ2=AZ2/10-10*IAZ2 
KAZ2=AZ2-100*IAZ2-10*JAZ2 
ALPHA2 ( 1 ) =CUAR ( I AZ2^4  8 ) 

ALPHA2 ( 2 ) =CHAR ( JAZ244  8 ) 

ALPUA2( 3)=CHAR(KAZ2448) 


WRITE 

I*. 

•) 

•• 

WRITE 

c. 

*) 

DETERMINE  PROFILE  TIMING  SEQUENCE" 

WRITE 

c. 

*) 

•• 

WRITE 

IV 

•) 

ENTER 

0.  1  OR  2  FOR  EACH  PROFILE" 

WRITE 

I*. 

•) 

WHITE 

c. 

•) 

0 

READ  PROFILE  DATA,  BUT  DO  NOT  USE 

WRITE 

c. 

•) 

*• 

WRITE 

c. 

•) 

1 

READ  AND  USE  PROFILE  DATA" 

WRITE 

1*. 

•) 

WRITE 

c. 

•) 

2 

PROFILE  MISSING  FROM  DATA  -  SKIP" 

WRITE 

c. 

•) 

" 

WRITE 

c. 

•) 

NOTE  - 

ALL  SIX  MUST  BE  DEFINED" 

WRITE 

•) 

00000291 
00000292 
00000293 
00000294 
00000295 
00000296 
00000297 
00000298 
00000299 
00000300 
00000301 
00000302 
00000303 
00000304 
00000305 
00000306 
00000307 
00000308 
00000309 
00000310 
00000311 
00000312 
00000313 
00000314 
00000315 
00000316 
00000317 
00000318 
00000319 
00000320 
00000321 
00000322 
00000323 
00000324 
00000325 
00000326 
00000327 
00000328 
00000329 
00000330 
00000331 
00000332 
00000333 
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00000335 
00000336 
00000337 
00000338 
00000339 
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00000341 
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00000343 
00000344 
00000345 
00000346 
0000034  7 
00000348 


WRITE  (V)  0  1  2  3  4  5" 

READ  (•.•!  NPROFS 
NAVGE=0 
DO  18  1=2.5 
M=NPROFS ( I ) 

IF  (NPROFS{I) .EQ.2)  M=0 
KAVGE=NAVGE*M 
18  CONTINUE 

WRITE  (*.•)  "  ■■ 

WRITE  (V)  ■■  SEARCHING  FILE  ",  INFILE 
WRITE  IV*)  '• 

L=0 

1  READ  ( 17. 100.END=80)  LINE 
100  FORMAT  (64A1) 

AZIMUTH=AZ 

IF  (L.GT.O)  GO  TO  20 

DO  10  MTIME=1,6 

TIMES ( MTIME ) =LINE ( MTIME*  6 ) 

10  CONTINUE 

DO  120  MTIME=7.10 

TIMES (MTIME ) =LINE(MTIME* 12 ) 

120  CONTINUE 

IF  (DATTIME.NE.TUREKTIME)  GO  TO  1 

20  L=L+1 

IF  (L.E0.7)  GO  TO  7 

IF  (NPROrS(l).EO.O.OR.NPROFS|l).E0.2)  GO  TO  9 
IF  (NPROFS{6) .EO.O.OR.HPROFS(6) .E0.2)  GO  TO  9 
IF  ((L.EO.l. AND. AZIMUTH. ME. ALPHl) 
•.0R.(L.E0.6.AKD.A2IMUTH.ME.ALPHin  THEN 
WRITE  (•,*)  '•  ■■ 

WRITE  (*.104)  L, AZIMUTH. ALPHl 
104  FORMAT  ("  AZIMUTH  ERROR  “.H.ZI.ZAl) 

CLOSE  (17) 

PAUSE  "  CR  TO  EXIT- 

STOP 

END  IF 

9  MY=LTIME(7.8) 

IF  (My.NE.89)  THEN 

WRITE  (•,*)  ERROR  EXIT  -  MY  =".My,"  CHECK  STATS 
PAUSE  ■■  CR  TO  EXIT- 
STOP 
END  IF 

WRITE  (*.100)  LINE 
READ  (17,100)  LINE 
WRITE  (*.100)  LIME 
READ  (17,100)  LINE 
WRITE  (•,*)  " 

1=0 

2  1=1+1 

GO  TO  (21. 22. 23. 24, 25. 26). L 

21  IF  (NPROFS(l) .E0.2)  THEM 
L=2 

GO  TO  22 
END  IF 

READ  (17.*.END=80)  ZP1( I ) .VP1(I ) .ERP1(I ) 

Z=ZP1(I) 

EHR=ERP1(I) 

GO  TO  3 
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00000371 

00000372 
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00000376 

00000377 

00000378 

00000379 

00000380 

00OC0381 

00000382 

00000383 

00000384 

00000385 

00000386 

00000387 

00000388 

00000389 

00000390 

00000391 
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• 

22  IF  (NPR0FS(2) .E0.2)  THEM 

00000407 

L=3 

00000408 

GO  TO  23 

00000409 

w 

END  IF 

00000410 

READ  (17.*,END=80)  ZR1( I ) . VR1{ I ) , ERR1( 1 1 

00000411 

Z=ZR1(I) 

00000412 

ERR=ERRi(I) 

00000413 

GO  TO  3 

000004 14 

23  IF  (NPROFSf 3) .EQ.2)  THEN 

00000415 

• 

L=4 

00000416 

GO  TO  24 

00000417 

END  IF 

00000418 

READ  (17.».END=80)  2R2( I ( . VR2{ 1 ) , ERR2{ I ) 

00000419 

Z=ZR2(I) 

00000420 

ERR=ERR2(I) 

00000421 

A 

GO  TO  3 

00000422 

W 

24  IF  (NPROFS(4J .E0.2)  THEN 

00000423 

L=5 

00000424 

GO  TO  25 

00000425 

END  IF 

00000426 

READ  (17.VEND=80)  ZR3|I)  .VR3(I)  .ERR3|I) 

00000427 

Z=ZR3(I) 

00000428 

• 

ERR=ERR3{I) 

00000429 

GO  TO  3 

000004  30 

25  IF  (NPROFS(5) .E0.2)  THEN 

00000431 

L=6 

000004  32 

GO  TO  26 

000004  33 

END  IF 

000004  34 

A 

BEAD  (17.VEND=80)  ZR4 ( 1 1 . VR4 ( I ) , ERR4 1 1 ) 

00000435 

# 

2*2R4 ( I ) 

00000436 

£RR=£RR4(I) 

00000437 

GO  TO  3 

000004  38 

26  IF  (NPROFS{6) .E0.2)  GO  TO  7 

00000439 

READ  (17.».END=80)  ZP2(I) .VP2{I) .ERP2(IJ 

00000440 

Z=ZP2(I) 

00000441 

• 

ERR=ERP2|I) 

00000442 

GO  TO  3 

00000443 

3  IF  (Z.LT. 999.0)  GO  TO  4 

00000444 

1=1-1 

00000445 

BACKSPACE  (17) 

00000446 

IF  (NMAX.LT.I)  NMAX=I 

00000447 

1=0 

00000448 

• 

GO  TO  1 

00000449 

4  IF  (ERR. LT. ZERO. OR. ERR. GT. 15.0)  THEN 

00000450 

1=1-1 

000004 SI 

GO  TO  2 

00000452 

END  IF 

00000453 

IF  (L.NE.l)  GO  TO  41 

00000454 

• 

WRITE  I*.*)  ZP1|I),VP1|I),ERP1(I).L,I 

00000455 

102  FORMAT  |F12.1.A1.F14.2.A1.F15.2.2I5) 

00000456 

GO  TO  2 

00000457 

41  IF  (L.NE.2)  GO  TO  42 

00000458 

WRITE  (»,»)  ZR1|I),VH1(I),ERR1(I).L.I 

00000459 

GO  TO  2 

00000460 

42  IF  (L.NE.3)  GO  TO  43 

00000461 

• 

WRITE  (',•)  ZR2|I),VR2|I),ERR2(I).L.I 

00000462 

GO  TO  2 

00000463 

43  IF  (L.NE.4)  GO  TO  44 

00000464 

• 
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WRITE  (V)  ZR3(I),VR3(I).ERR3(I),L,I 
GO  TO  2 

44  IF  {L.NE. 5)  GO  TO  45 

WRITE  (*.•)  ZR4(I).VR4(I).ERR4(I).L,I 
GO  TO  2 

45  IF  (L.NE. 6)  GO  TO  26 

WRITE  (*,•)  2P2(I).VP2|I).ERP2(I),L.I 
GO  TO  2 

7  WRITE  (•. 103) 

103  FORMAT  (/ "  INTERVAL  ACCEPTED"/) 


C  CALCULATE  AVERAGE  WINDS  FROM  PROFILES 
C 

CALL  RADIAL 

C 

IF  (NPROFS(l) .E0.1.AND.NPR0FS{6) .E0.2)  THEN 
CALL  NORMAL  (ZPl. VPl, ERPl) 

END  IF 

C 

IF  (NPR0FS(1).E0.2.AND.NPR0FS(6).E0.1)  THEN 
CALL  NORMAL  {2P2.VP2,ERP2) 

END  IF 
C 

IF  (NPROFS(l) .EQ.l.AND.NPROFS(6).EQ.I)  THEN 
CALL  PERP 
END  IF 
C 

WRITE  (*,•)  NR. HP 
IF  {NR.LT.2.0R.MP.LT.2)  THEN 

WRITE  ( • .  • )  INSUFFICIENT  HEIGHTS  -  MO  NS-EW  CALCULATED; 
•  EXECUTION  TERMINATED" 

PAUSE  CR  TO  EXIT" 

STOP 
END  IF 

WRITE  (»,•)  "  NS  AND  EW  COMPONENTS" 

DEFINE  PROJECTKMJ  ANGLES  APPROPRIATE  TO  INPUT  AZIMUTHS 
FOR  USE  IN  DETERMINING  ZONAL  AND  MERIDIONAL  WINDS 


COS 33=COS{ 33.0/RAD) 

COS57=COS( 57.0/RAD) 

CALCULATE  NS,  EW  PROFILES  FROM  ZPl.ZRl  AND  ZP2.ZR4  ONLY 
IF  AVAILABLE  (I.E.  "EARLY"  AND  "LATE"  COMPONENTS) 

IF  (NPROrS(l) .E0.1.AND.NPR0rS|6) .EO.l)  CALL  NSEWl 

CALCULATE  ZONAL  AND  MERIDIONAL  CCMP(»i£NTS 


CALL  NSEH2 

79  WRITE  (*,•)  "  ISR  PROCESSING  COMPLETED" 
CLOSE  (17) 

RETURN 

80  PAUSE  "  EOF  -  CHECK  STATS  FILE.  CR  TO  EXIT- 
CLOSE  (17) 

STOP 

90  PAUSE  "  ZP1=0.  CR  TO  EXIT- 
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CLOSE  ( 17) 

STOP 

END 

SUBROUTINE  RADIAL 
DIMENSION  ZALL  (30) 

CHARACTER* 1  TAB 
CHARACTER'S  ALPH1.ALPH2 

COMMON  /ZRADIAL/  ZR1( 60) ,VR1( 60) .ERR1( 60) , 

•  ZR2(60).VR2(60),ERR2(60). 

•  ZR3(60).VR3{60).ERR3{60). 

•  ZR4(GCj.VR4(60).ERR4(60) 

COMMON  /ZAP/  ZRO(60).VRO(60).ERRO(60). 

•  ZPO(60) .VPO(60) .ERPO(60) 

COMMON  /EXTRAS/  ZERO,ALPHl,ALPH2.NR.NP.NMAI.TAB.NAVGE.NPROtS{ 6) 
COMMON  /ARRAYS/  A|43.33) 

C 

SINZEN=SIN( 11 . 3/ 57. 29578) 

HALF=0 . 5 

WRITE  (*.100)  ALPH2 

100  FORMAT  (■■  e  ■■.A3."-  AZIMUTH  OUTPUT") 

C 

DO  50  1=1.28 
ZALL(I)=97-I 
50  CONTINUE 

ZALL(29)=ZERO 
NR=0 
1=0 

CHOOSE  ONLY  DATA  BETWEEN  69  AND  96KM 

IF  {NPROFS(2) .NE.l)  GO  TO  56 

54  I=I+1 
NR=NB+1 

IF  (ZALL(I) .EO.ZERO)  THEN 
NR=NR-1 
GO  TO  66 
END  IF 

DO  55  11=1.60 

IF  (ZRl(II) .EO.ZERO)  GO  TO  54 
IF  |ZALL(I) .NE.ZR1{II))  GO  TO  55 
ZRO(NB)=ZALL{I) 

VR0|NR)=VR1|II) 

ERR0(NR)=ERR1(II) 

DO  540  JJ=1.60 

IF  |ZH2(JJ) .EO.ZERO)  GO  TO  54 
IF  (ZALL(I),NE.ZR2(JJ))  00  TO  540 
ERRO(NR)=ERRO(NR)+HALF*SORT( (VRO(NR)-VR2( JJ) ) **2 
•♦ERR2(JJ)*ERR2(JJ)) 

540  CONTINUE 

55  CONTINUE 
GO  TO  54 

56  IF  (NPROFS(5) .NE.l)  GO  TO  66 
NR=0 
1=0 

64  1=1*1 
NR=NR+ 1 

IF  (ZALL(I) .EO.ZERO)  THEN 
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NR=NR- 1 
GO  TO  66 
END  IF 

DO  65  11=1.60 

IF  (ZR4(II| .EQ.ZERO)  GO  TO  64 
IF  (ZALL(I) .NE.ZR4(II))  GO  TO  65 
ZRO(NR)=ZALL(I) 

VRO(MR)=VR4(II) 

ERRO(NR)=ERR4(II) 

DO  640  JJ=1.60 

IF  (ZR3(JJl .EO.ZEROl  GO  TO  64 
IF  (ZALL(I).NE.ZR3(JJ))  GO  TO  640 
ERRO(NR)=ERRO{MR)*HALF*SORT( {VRO(MR)-VR3( JJ ) ) • • 2 
•♦ERR3(JJ)*ERR3(JJ) ) 

640  CONTINUE 

65  CONTINUE 
GO  TO  64 

66  1=0 

DO  67  IJ=1.NR 
IF  (ZRO(IJ) .NE.ZERO)  THEN 
1=1  +  1 

ZRO(I)=ZRO(IJ) 

VRO{I)=VRO(IJ) 

ERRO(I)=ERRO|IJ) 

VRLOS=VRO| I ) 'SINZEN 
ERRLOS=ERRO{ I ) 'SINZEN 
IH=112.1-ZHO(I) 

A(IH.28)=VRLOS 

A(IU,29)=ERRLOS 

WRITE  (*.102)  2RO|I).TAB,VRO|I),TAB.EBRO(I> 

102  FORMAT  (F12.1.A1,F14,2.A1.F15,2) 

END  IF 
67  CONTINUE 
ZRO|I+l)=ZERO 
70  RETURN 
END 

SUBROUTINE  NORMAL  (ZP.VP.ERP) 

DIMENSION  ZP(60).VP|60).ERP{60) 

CHARACTER* 1  TAB 

CHARACTER* 3  ALPH1,ALPK2 

COMMON  /ZAP/  ZRO(60),VRO(60),ERRO(60), 

*  ZPO{ 60 ) . VPO| 60 ) . ERPO( 60 ) 

COMMON  /EXTRAS/  ZER0,ALPH1,ALPH2.NR.NP.NHAX,TAB 
C0tQ«»(  /ARRAYS/  A(43.33) 

SINZEH=SIN( 11 . 3/ 57 . 29578) 

WRITE  (*.106)  ALPHl 

106  FORMAT  | "  ".AS."*  AZIMUTH  OUTPUT") 

DO  50  IK=1.60 
ZPO|IK)=ZP(IK) 

IF  |ZPO(IK).EO. ZERO. OR. ZPO(IK).GT. 999.0)  GO  TO  51 
VPO(IK)=VP(IK) 

ERPO(IK)=ERP{IK) 

VPLOS=VPO( IK) *SINZEN 
ERPLOS=ERPO( IK) *SINZEH 
IH=112.1-ZPO{IK) 

A(IH,30)=VPLOS 

A(IH.31)=ERPLOS 

WRITE  (*,101)  ZPO|IK),TAB,VPO|IK).TAB.ERPO|IK) 
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101  FORMAT  (F12. 1.A1.F14 .2.A1.F15.2) 

50  CONTINUE 

51  NP=IK-1 
RETURN 
END 

SUBROUTINE  PERP 

CHARACTER* 1  TAB 

CHARACTER* 3  ALPH1.ALPH2 

COMMON  /ZPERP/  2P1| 60) . VPl { 60) . ERP1{ 60) , 

*  ZP2(60).VP2(60).ERP2(60) 

COMMON  /ZAP/  ZRO(60).VRO(60).ERRO(60), 

•  ZPO(60).VPO(00).£RPu(t>0) 

COMMON  /EXTRAS/  ZERO. ALPHl. ALPH2,NR.NP,NMAX.TAB.NAVGE.NPROFS( 6) 
COMMON  /ARRAYS/  Ai43,33) 

WRITE  (*.101)  ALPHl 

101  FORMAT  ("  ■•.A3,  ‘  AZIMUTH  OUTPUT") 

SINZEN=SIH| 11.3/57. 29578) 

NP=0 

DO  56  I=1.NMAX 

IF  (2P1|I) .GT. 1000.0)  GO  TO  60 
IF  (ZPl(I) .EQ.ZERO)  GO  TO  60 
DO  55  J=1.NMAX 

IF  (2P2(J).EO.ZERO)  GO  TO  56 
IF  (2P1(I) .NE.2P2IJ))  GO  TO  55 
NP=NP*1 
ZPO(NP)=ZP2(J) 

VPO{NP)={VP1(I)+VP2(J))/2.0 

ERPO ( NP ) *SORT  { I VP 1 ( I ) -VPO( NP ) ) • *  2* ( VP2 { J  > -VPO) NP ) ) • *  2 
**ERP1(I)*'2+ERP2(J)**2) 

VPLOS=VPO ( NP ) • S INZEN 
ERPLOS=ERPO ( NP ) • S INZEN 
IH=112.1-2PO(NP) 

A(IH, 30)=VPLOS 
A(IH.31)=ERPLOS 

WRITE  (*.102)  ZPO(NP),TAB.VPO(NPj.TAB.ERPO(HP) 

102  FORMAT  (F12. 1. Al. F14 . 2. Al. F15. 2) 

55  CONTINUE 

56  CONTINUE 
60  RETURN 

END 

SUBROUTINE  NSEWl 

CHARACTER* 1  TAB 

CHARACTER* 3  ALPHl, ALPU2 

COttiOK  /ZPERP/  ZP1{60).VP1|60).ERP1{60). 

•  ZP2(60).VP2{60).ERP2(60) 

COMMON  /ZRADIAL/  ZR1( 60) ,VR1{ 60) .ERR1( 60) . 

*  ZR2|60).VR2(60).ERR2(60). 

•  ZR3{60).VR3(60).EBR3(60). 

*  ZR4(60),VR4(60),EBR4(60) 

COMMON  /EXTRAS/  ZEHO.ALPHl, ALPH2.NR,NP.HMA1.TAB.NAVGE,NPR0FS( 6) , 
*COS33.COS57 

IF  (NPROFS(1).EO.O.OR.NPROFS|1).E0.2)  GO  TO  69 
WRITE  (*,105) 

105  FORMAT  (/"  EARLY  NS,  EW  WIND",//) 

WRITE  (*.106) 
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106  FORMAT  (/  HEIGHT  VEW  ERREW  VNS  ERRNS"/) 

1=0 

64  1=1*1 

IF  (I.GT.60I  GO  TO  69 
IF  (2R1(I) .GT.95.0)  GO  TO  64 
IF(ZR1(I) .EQ.ZERO)  GO  TO  69 
DO  65  J=1.60 

IF  {ZPl(J) .EQ.ZERO)  GO  TO  64 
IF(ZR1(I) .NE.ZPl(J) )  GO  TO  65 
IF  (ALPHl.EO. '  ^OS")  THEJf 
VEW=VR1 ( I ) 'COS 57-VP 1 ( J ) ‘COS 33 
'/HS^VRl ;  I ) 'COS 33*VP  1  ( J ) ‘CO? 57 

EREW=SORT  ( (ERRl(I)*COS57)*»2*{ERPl(J)*COS33)**2) 

ERHS=SORT  ( (ERRl(I)*COS33)**2*(ERPl|J)*COS57)"2) 

ELSE 

VEW=VR1 ( I ) • COS 33-VP 1 ( J ) • COS 57 
VNS=-VR1 ( I ) 'COS 57-VPl ( J ) ‘COS 33 

EREW=SOHT  ((EHR1(I1*OOS331**2*|ERP1(J1*COS57)»*2) 

ERHS=SORT  ( {ERRl{I)*COS57)**2*(ERPl(J)»COS33)*»2) 

EMD  IF 

WRITE  I*. 107)  ZP1(J1 .TAB.VEW.TAB.EREW.TAB.VKS.TAB.ERKS 

107  FORMAT  { F8. 1. 4 ( A1 . F8. 1) ) 

GO  TO  66 

65  COKTIHUE 

66  GO  TO  64 

69  IF  (MPROFS(6) .EO.O.OR.NPROFS(6).EQ.2>  RETURN 
WRITE  {'.108) 

108  FORMAT  (/'  LATE  MS.  EW  WIND”.//) 

WRITE  (M06) 

1=0 

74  1=1*1 

IF  (I.GT.60)  GO  TO  79 
IF  {ZH4(I). GT.95.0)  GO  TO  74 
IF(ZR4(I) .EQ.ZERO)  GO  TO  79 
DO  75  J=1.60 

IF  (ZP2|J) .EQ.ZERO)  GO  TO  74 
IF(ZR4(I) .NE.ZP2(J))  GO  TO  75 
IF  {ALPH1.EQ."303")  THEN 
VEW=VR4 ( I ) • COS  57-VP2 1 J ) • COS  33 
VNS=VR4 ( I ) 'COSSS+VPai J ) 'COSST 
ELSE 

VEW=VR4 ( I ) • COS  33-VP2 { J ) • COS  57 

VNS=-VR4 { I ) • COS  57-VP2 1 J ) • COS  33 

EREW=SORT  ((ERR4(I) *00533) ••2*{ERP2(J) *00557) ••2) 

ERMS=SORT  ( |ERR4|I)*COS57)**2*{ERP2(J)*COS33)**2) 

END  IF 

WRITE  {*.107)  ZP2(J).TAB.VEW.TAB.ER£W,TAB.VNS.TAB.EHNS 
GO  TO  76 

75  CONTINUE 

76  GO  TO  74 
79  RETURN 

END 

SUBROUTINE  NSEW2 

CHARACTER*!  0(3). TAB 

CHARACTER* 3  ALPH1.ALPH2 

COMMON  /ZAP/  ZRO(60),VRO(60).ERRO(60}. 

•  ZPO{60).VPO(60).ERPO(60) 

C0M10N  /EXTRAS/  ZERO.ALPHl.ALPH2.MR.NP.NMAX.TAB.MAVGE.NPROFS(6) . 
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•COS33.COS57,D 
COmON  /ARRAYS/  A(43.33) 

WRITE  (MOO) 

100  FORMAT  (//•■  ZONAL  AND  MERIDIONAL  ISR  WINDS" 

•//•  0  HEIGHT  VEW  ERREW  VNS  ERRNS"/) 

SIGN=1.0 

IF  (ALPHl.EO.  ■•213")  SIGN=-1.0 
1=0 

74  I=I+1 

IF(ZRO(I) .EQ.ZERO)  GO  TO  79 
DO  75  J=l. 60 

IF  (ZPO(J) .EO.ZERO)  GO  TO  74 
IF(ZRO(I) .NE.ZPOl J) )  GO  TO  75 
IF  (ALPHl.EO. "SOS")  THEN 
VEW=VRO ( I ) • COS  57-VPO ( J ) • COS  33 
VNS=VRO( I ) •COS33+VPO( J ) *00557 

EREW=SORT  {(ERRO(I)*COS57)**2*<ERPO(J)*COS33)»*2) 
ERHS=SORT  ((ERRO{I)*COS33)**2»(EHPO|J)*COS57)**2) 

ELSE 

VEW=VRO( I ) 'COS  33-VPO( J ) *00357 
VNS=-VRO( I ) *COS 57-VPO( J ) ‘COS 33 
EREW=SORT  {(ERRO|I)*COS33)**2*(ERPO(J)*COS57)*»2> 
ERNS=SORT  ( ( ERRO( I ) *COS57 ) *  *  2* ( ERPO( J  J ‘COS  33) • • 2 ) 

END  IF 

WRITE  (*.101)  ZP0(J).TAB.VEW.TAB.£REW.TAB.VNS,TAB.ERNS 

101  FORMAT  (F8.1.4{A1,F8,1)) 

11=112. l-ZPO(J) 

A|II.14)=VEW 

A(II. 15|=ER£W 
A(II.16)=VHS 
A{II.17)=ERNS 
GO  TO  74 

75  CONTINUE 
GO  TO  74 

79  RETURN 
END 

SUBROUTINE  INTERVAL 
CHARACTER* 10  TUREKTIHE 
CHARACTER* 27  LIST 

INTEGER  *  4  INTNUW . YEAR . MONTH , DAY . HOUR . MINUTE . HONLQHG , NOW . 
•STRT2HOUR. STRT3HOUR. STRT2MIN. STRT3MIH. 

*END2UOUR, END3HOUR, END2HIN. END3HIN 


.NOW, INTHALF.STHT2HOUR.STHT3MOUR.STHT2MIN,STRT3MIH, 

00000709 

END2HOUR , END3HOUR . END2HIN , END3MIN 

00000800 

COMKW  /EXTRAS/  LIST,NPROFS| 6) 

00000801 

00000802 

IF  (NPROFS(l).EO.l)  THEN 

00000803 

ENI»iOUR=END2HOUR 

00000804 

ENDMIN=END2MIN 

00000805 

END  IF 

00000806 

IF  (NPROFS(5) .EO.l)  THEN 

00000807 

HOUR=STRT2HOUR 

00000808 

MINUTE=STRT2MIM 

00000809 

ENOHOUR=EN03HOUR 

00000810 

EHDMIN=EHD3MIN 

00000811 

END  IF 

00000812 
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C 

HOWLONG=(  60»ENDHOUll*EKDHI}l )  -  (  60*HOUR»MINUTE ) 

DEFINE  MIDPOINT  TIME,  AND  CONVERT  TO  LOCAL  MEAN  SOLAR 
ASSUMES  DAYTIME  INTERVAL  IE.  DOES  NOT  TEST  FOR  CHANGE  OF  DAY 

INTHALF=HOWLONG/ 2 
MINUTE=MINUTE* INTHALF-28 
IF  ( MINUTE .GT.S9)  THEN 
HOUR*HOUR* 1 
MINUTE=MINUTE-60 
END  IF 

IF  (MIMUTE.lt. 0)  THEN 
HOUR=HOUR-l 
MINUTE=MINUTE*60 
END  IF 
RETURN 
END 

SUBROUTINE  GNSEWIDI 

MAY  5.  1993 

CALCULATES  INPUT  FILE  DESIGNATOR  XlXXXl  AND 
READS  GROVES  OUTPUT  FILES  "XXXXXXTIDE-oOR  "XXXXXXGROOUT" 

USING  INTERVAL  MIDPOINT  LOCAL  MEAN  SOLAR  TIME 
TO  PRODUCE  ZCMAL  MERIDICMAL  AND  LINE  OF  SIGHT 
PROFILES,  WITH  ERRORS,  AT  1  KM  INTERVALS  BETWEEN 
69  AND  111  KM 

REQUIRES  SUBROUTINES 

GPROFl 
GPROFZ 

DIMENSION  STRTEW{ 50 ) , STRTNS { 50 ) , ENDEWf  50) . ENI»IS { 50 ) , 

• STRTVERT | 50 ) , ENDVERT ( 50 ) , WINDEW ( 50 ) , WINDNS ( 50 ) , VERT ( 50 ) . 

• ERREW ( 50 ) , ERRNS ( 50 ) , ERRVERT ( 50 ) 

CHARACTER  *40  TIDE.GROOUT 
CHARACTER* 10  TUREKTIME 
CHARACTER*!  DUmYl{25)  ,0UM1Y2{25), WHICH 
INTEGER  *  4  INTNUM . YEAR . MONTH . DAY , HOUR .MINUTE , HOWLONG . NOW , 
*Y£AR10,Y£ARl,M<»rrH10,MONTHl, IDAYIO. IDAYl 
COMMON  /ARRAYS/  A(43, 33) 

COMMON  /TIMER/  INTNUM, YEAR. MCMfTH. DAY. HOUR. MINUTE, TUREKTIME. 
*HOWLONG.NOW 

EQUIVALENCE  (TIDE.DUMMYl) 

EQUIVALENCE  (CROOUT,DUMMy2) 

WRITE  (*.*)  ■■  " 

WRITE  {*.*)  '•  GET  GROVES  VELOCITIES,  ERRORS" 

WRITE  (*.*)  "  •• 

TWO=2.0 
TWOPI=6. 28318 
SIXTY=60.0 
RAD=57. 29578 
SINZ£N=SIN{11.3/RAD} 

COS 57=COS( 57.0 /RAD) 

COS 33=COS{ 33.0 /RAD) 

C 

T=HOUR*MINUTE/ SIXTY 
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• 

HALnNT=rLOAT|HOWLONG)  /  ITWO'SIXTY) 

00000871 

c 

00000872 

c 

DETERMINI  U,V  AND  W 

00000873 

• 

c 

00000874 

c 

GET  GROVES  DATA  ( XHXGROOUT  OR  XXXXXITIDE  FILE) 

00000875 

c 

00000876 

WRITE  (•,*)  ■  ENTER  T  FOR  TIDE.  G  FOR  GROOUT  INPUT' 

00000877 

READ  (•.*)  WHICH 

00000878 

TIDE= 'MAXTOReOO: IDIGNSEW:  TIDE" 

00000879 

• 

GROOUT="MAXTOR600: IDIGNSEW;  GROOUT" 

00000880 

c 

00000881 

c 

CALCULATE  GROVES  INPUT  FILENUMBER 

00000882 

c 

OC'^00883 

IDAY=DAr 

Oi-  .00884 

IF  (HOUR. LT. 12)  IDAY=IDAY-1 

00000885 

YEAR10=YEAR/ 10 

00000886 

• 

YEAR  1  =Yi:AR- 1 0  •  YEAR  1 0 

00000887 

MONTH10=MONTH/ 10 

00000888 

MONTH  l=MOHTH- 1 0  •  MONTH  1 0 

00000889 

IDAY10=1DAY/10 

00000890 

IDAY1=IDAY-10*IDAY10 

00000891 

DUMMYl ( 20) =CHAR(yEAR10*48) 

00000892 

• 

DUMMY 1 ( 2 1 ) =CHAR ( YEAR 1 ♦ 4 8 ) 

00000893 

DUMMY1( 22)=CHAR(MONTH10*48i 

00000894 

DUMMY 1 ( 2 3 ) =CHAR ( MONTH 1 ♦ 4 8 ) 

00000895 

DUMMY1(24 )=CHAR( IDAYlO+48) 

00000896 

DUMMYl (  25)  =CHAR(  IDAYU4 8) 

00000897 

DO  1  1=20.25 

00000898 

DUMMY2(I)=DUMMY1(I) 

00000899 

• 

1  CONTINUE 

00000900 

IF  (WHICH.EO.'T")  THEN 

00000901 

OPEN  ( 15. FILE=TIDE . ACTION* "READ" . FOMl=-UNFORMATTED” ) 

00000902 

WRITE  (•.*)  ■' 

00000903 

WRITE  (•.*)  '■  ACCESSING  FILE  ".TIDE 

00000904 

CALL  GPROFl  (T.WINDEW) 

00000905 

• 

CALL  GPROFl  (T.WINDNS) 

00000906 

CALL  GPROFl  (T.VERT) 

00000907 

c 

00000908 

c 

CALCULATE  "ERRORS"  IN  U  AND  V  BY  DETERMINING  GROVES 

00000909 

c 

PROFILES  FOR  SAME  LENGTH  OF  INTERVAL  CENTERED  ON  BEGINNING 

00000910 

c 

AND  END  OF  I SR  INTERVAL 

00000911 

c 

00000912 

• 

T=T-HALFINT 

00000913 

REWIND  (15) 

00000914 

CALL  GPROFl  (T.STRTEW) 

00000915 

CALL  GPROFl  (T.STRTNS) 

00000916 

CALL  GPROFl  (T.STRTVERT) 

00000917 

T=T*TWO*IIALFINT 

00000918 

REWIND  (15) 

00000919 

w 

CALL  GPROFl  (T.ENDEW) 

00000920 

CALL  GPROFl  (T.ENDNS) 

00000921 

CALL  GPROFl  (T.ENDVERT) 

00000922 

ELSE 

00000923 

OPEN  1 15. FILE=GROOUT . ACTION* "READ” . FORM="FORMATTED" ) 

00000924 

WRITE  (•.*)  "  " 

00000925 

WRITE  I*.*)  "  ACCESSING  FILE  ".GROOUT 

00000926 

CALL  GPROF2  (T.WINDEW.WINDNS.VERT) 

00000927 

c 

00000928 

• 
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CALCULATE  ' ERRORS"  IN  U  AMD  V  BY  DETERMINING  GROVES 
PROFILES  FOR  SAME  LENGTH  OF  INTERVAL  CENTERED  ON  BEGINNING 
AND  END  OF  ISR  INTERVAL 

T=T-HALFINT 
REWIND  (15) 

CALL  GPR0F2  (T,STRTEW.STRTNS,STRTVERT) 

T=T*TWO*HALFINT 
REWIND  (15) 

CALL  GPR0F2  ( T . ENDEW . ENDNS . ENDVERT ) 

END  IF 
CLOSE  (15) 

SAVE  NS  AND  EW  GROVES  WIND.  WITH  ERRORS 

NOTE  THAT  THESE  ARE  NOT  EQUIVALENT  VELOCITIES  WITH  W=0 


DO  2  1=1,43 
A(I, 1)=112-I 
A(I.2)=WINDEW(I) 

ERREW(I)=ABS  (EHDEW(I)-STRTEW(I) )/TWO 
A(I, 3)=ERREW(I) 

A(I.4)=WINDNS(I) 

ERRNS ( I ) =ABS  ( ENDNS ( I ) -STRTNS ( I ) ) /TWO 
A(I, 5)=ERRNS{I) 

A(I.6)=VERT(I) 

ERRVERT ( I ) =ABS  ( ENDVERT ( I ) -STRTVERT ( I ) ) / TWO 
A(I. 7)=ERRVERT(I) 

A(I.21)=SQRT((ERREW(I)*COS57*SINZEN)"2 
• ♦ ( EBBNS ( I ) 'COS 33*SIH2EH) • *2 ) 

A ( I . 2 3 ) =SORT ( ( ERREW ( I ) • COS 3 3* S INZEN ) • • 2 
• ♦ (ERRNS ( I ) •COS57*SIHZEN) • *2) 

2  CONTINUE 

CALCULATE  GROVES  LINE  OF  SIGHT  VELOCITY 
CALL  SUBVERT  (WINDEW. WINDNS.VERT. 1) 

WRITE  (•,•)  " 

WRITE  {«,•)  ■■  TIDAL  WINDS  CALCULATED- 
WRITE  (*,•)  '• 

RETURN 

END 

SUBROUTINE  GPROFl  (T.WIND) 

DECEMBER  16,  1902 

DETERMINES  GROVES  WIND  FROM  FILE  "IIXXHTIDE" 

DIMENSICW  AU(4),PH(4),WIND(50) 

TW0PI=6. 28318 

SKIP  DOWN  TO  lllKM 

DO  1  1=1,5 

READ  (15)  UO, (AU(J) ,PH(J) .J=l,2) 

1  CONTINUE 

DETERMINE  WIND  PROFILE 
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DO  2  1=1.46 

READ  (151  UO. (AU(J).PH(J).J=1.2| 

IF  (PH(l).LT.T)  PHASE 1=PH( 1)-T 
IF  (PH(l).GE.T)  PHASE1=T-PH( 1} 

IF  {PH(2).LT.T)  PHASE2=PH(2)-T 
IF  (PH(2).GE.T)  PHASE2=T-PH(2) 

WIND( I ) =UO+ AUj 1 ) 'COS ( ( PHASE 1 / 24 . 0 ) ‘TWOPI ) 

• *AU( 2 1 'COS ( ( PHASE2/ 12 . 0 ) ‘TWOPI I 
2  CONTINUE 
RETURN 
END 

SUBROUTINE  GPROF2  (T.VX.VY.VW) 

MARCH  8.  1993 

READS  GROVES  WIND  FROM  FILE  •IIXMIGROOUT" 

CHARACTER'S  DIRNVERT. WHATVERT 
CHARACTER* 9  DIRNEW, WHATEW 
CHARACTER* 11  DIRNNS . WHATNS 

DIMENSION  VX( 50) ,VY{ 50) ,VW( 50) , VXL( 25) . VYL( 25) , VWL( 25) 
IF  (T.LT.12)  IT=T+24 
IF  (T.GE.12)  IT=T-11 
DIRNEW=" EAST-WEST" 

DIRNNS="NORTH-SOUTH" 

DIRNVERT="VERTICAL" 

SKIP  DOWN  TO  EAST-WEST  lllKM 

1  READ  (15.*)  WHATEW 

IF  { WHATEW. NE. DIRNEW)  GO  TO  1 

DO  2  1=1. 7 

READ  (15.*)  WHATEW 

2  CONTINUE 

DO  3  K=1.46 

READ  (15.100)  IH. (VXL(J).J=1.24) 

100  FORMAT  (I5.F8.0.23F5.0) 

VX(K)=VXL(IT) 

3  CONTINUE 

SKIP  DOWN  TO  NORTH  -  SOUTH  lllKM 

4  READ  (15.*)  WHATNS 

IF  ( WHATNS. NE. DIRNNS)  GO  TO  4 

DO  5  1=1.7 

READ  (15.*)  WHATNS 

5  CONTINUE 

DO  6  K=1.46 

READ  (15.100)  IH, (VYL(J).J=1.24) 

VY(K)=VYL(IT) 

6  CONTINUE 


SKIP  DOWN  TO  VERTICAL  lllKM 

7  READ  (15,*)  WHATVERT 

IF  ( WHATVERT. NE. DIRNVERT)  GO  TO  7 
DO  8  1=1.8 
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READ  (15.*)  WHATVERT 

8  CONTINUE 
C 

DO  9  K=1.46 

READ  (15,100)  IH. {VWL(J) .J=1.24) 

VN(K)=VWL(IT) 

9  CONTINUE 
C 

RETURN 
END 

SUBROUTINE  SUBVERT  (U.V.W.NGO) 

JULY  11,  1993 

TRANSFER  U.V  AND  W  TO  ISR  LINES  OF  SIGHT 
THEN  RECOVER  NS.  EW  COMPONENTS,  ASSUMING  W=0  (C.F.  ISR) 

INTEGER* 4  AZ1.AZ2 
DIMENSION  U{50).V(50).W(50) 

COMMON  /ANGLES/  AZ1.A22 
COMMON  /ARRAYS/  A|43.33) 

RAD=57. 29578 
ZEN=11.3/RAD 
SINZEN=SIN(ZEN) 

COS33=COS( 33.0/RAD) 

COS 57=COS{ 57.0 /RAD) 

RA21=FL0AT(AZ1)/RAD 
RA22=FLOAT(AZ2)/RAD 
DO  4  1=1,43 

IF  (U(I) .GT. 200.0)  GO  TO  4 
IF  (NGO.EO.l)  W(I)=W(I)/100.0 

VR=U( I ) •SIN(RAZ2) 'SINZEN+VI 1 1 •C(»(RAZ2) ‘SINZEN^WI I ) 'COSIZEN) 
VP=U{ I ) 'SIN! RAZl ) 'SINZEN+Vt I ) 'Cost RAZl ) 'SINZENJiWI I ) 'COS ( ZEN) 
GO  TO  (1.2).NGO 

1  A{I,20)=VR 
A{I.22)=VP 
GO  TO  3 

2  A{I.24)=VR 
A(I.26)=VP 

3  VRHOR=VR/SINZEN 
VPHOR=VP/SINZEN 
IF  (AZ1.E0.303)  THEN 
U( I )=VRHOR*COS57-VPHOR*COS33 
V( I )=VHHOR*COS33+VPHOR*COS57 
ELSE 

U 1 1 ) =VRHOR*  COS  33-VPHOR*  COS  57 
V| I )=-VRHOR*COS57-VPHOR*COS33 
END  IF 

IF  (NGO.EO.l)  W(I)=W|I)*100.0 

4  CONTINUE 
RETURN 
END 

SUBROUTINE  NSEWIDI 

MAY  19.  1993 

CALCULATES  NS,  EW  AND  VERTICAL  IDI  WINDS  WITH  ERROR  ESTIMATES 

CHARACTER* 1  POLAR 
CHARACTER* 10  TUREKTIME 
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INTEGER • 4  INTNUM , YEAR . MONTH . DAY . HOUR . MINUTE . HOWLONG . NOW 
REALM  NINES. HALF 

^  COMMON  /IDIVEL/  U( 50 ) , V( 50 ) , W( 50 ) .Ul{ 50 ) . Vl( 50) . W1 ( 50) . 

•  •U2(50).V2(50),W2(50) 

COMMON  /ARRAYS/  A{43.33) 

COMMON  /SPPFILE/  IFILE.NFILE, POLAR 

COMMON  /TIMER/  INTNUM, YEAR. MONTH. DAY. HOUR. MINUTE, TUREKTIME. 
•HOWLONG. NOW 

C 

•  WRITE  (*.*)  '■  " 

WRITE  (*.*)  ■■  DETERMINE  IDI  WINDS" 

NINES=999 . 0 
HALF=0 . 5 
RAD=57. 29578 
SINZEN=SIN(11.3/RAD) 

COS 57=COS( 57.0 /RAD) 

COS 33=COS( 33.0 /RAD) 

MORE  PARAMETERS 

P0LAR="0" 

FOLLOWING  CAN  BE  ACTIVATED  FOR  POLARIZATION  TESTS 
CURRENTLY  SET  TO  ACCEPT  "0"  ONLY 
WRITE  (•,*)  "  " 

WRITE  (•,*)  ■'  SELECT  POLARIZATION  -  ENTER  0.  1.  L  OR  ALL" 
READ  (•,•)  POLAR 
WRITE  (•.•)  '•  " 

WRITE  {»,•)  ■  ENTER  FIRST  SPP  -  OR  FILE  NUMBER' 

READ  (•■•)  NFILE 

WRITE  (•,*)  "  " 

WRITE  (*,•)  "  •••••  IDI  WIND  PROFILE  •••••" 

WRITE  (*.•)  "  " 

CALL  IDI  (U.V.W) 

SAVE  IDI  NS  AND  EW  COMPONENTS 

DO  1  1=1,43 

IF  (ABS(U(I) ) .GT. 200.0)  GO  TO  1 
A(I.32)=U(I) 

A(I,33)=V{I) 

1  CONTINUE 

TRANSFER  TO  ISR  LINES  OF  SIGHT 

THEN  RECOVER  IDI  NS.  EW  COMPONENTS.  ASSUMING  W=0  (C.F.  ISR) 
CALL  SUBVERT  (U.V.W, 2) 

CALCULATE  ERROR  AS  HALF  (VELOCITY  FOR  INTERVAL  AFTER 
MINUS  VELOCITY  FOR  INTERVAL  BEFORE)  AT  EACH  ALTITUDE 

INTHAL7=H0WL0NG/ 2 

•  MINUTE^INUTE^INTUALF 

IF  ( MINUTE. GT. 59)  THEN 
HOUR=HOUR+ 1 
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MINUTE=MINUTE-60 
END  IF 

WRITE  (•.•)  ■■ 

WRITE  {•.•!  "  •••••  ERROR  CALCULATION  -  PASS  1  •••••■ 

WRITE  (•,') 

CALL  IDI  (Ul.Vl.Wl) 

MINUTE=MINUTE-HOWLONG 
IF  (MINUTE. LT.O)  THEN 
HOUR=HOUR-l 
MIKUTE=MINirrE*60 
END  IF 

WRITE  (•.’)  ■■ 

WRITE  (  •  ,  •  J  ■■  •  •  •  •  “  ERROR  CALCULATION  -  PASS  2  •••••■ 

WRITE  (*,•)  "  '■ 

CALL  IDI  {U2.V2.W2) 

STORE  IDI  NS,  EW  AND  VERTICAL  COMPONENTS.  WITH  ERRORS.  IN  ARRAY  A 

WRITE  (*.•)  "  " 

DO  2  1=1,43 

IF  (ABS{U(I)|.GT. 200.0)  THEN 

U(I)=NINES 

V(I)=NINES 

W(I)=NINES 

GO  TO  2 

END  IF 

A(I,8)=U(I) 

ERR£W=HALF'ABS(U1(I)-U2(I) ) 

IF  (Ul(I).EO.NINES)  ERREW=ABS{U(I)-U2(I)) 

IF  (U2(I) .EO. NINES)  ERREW*ABS (U( I )-Ul{ I ) ) 

IF  (ERREW.LT.5.0)  ERREW=5.0 

IF  (ERREW.GT.50.0)  ERREW=0.0  !NO  ERROR  CALCULATED  -  NO  ERROR  BAR 

A(I.9)=ERREW 

A(I.10)=V(I) 

ERRNS=HALF*ABS ( VI 1 1 ) -V2| I ) ) 

IF  {V1(I) .EO. NINES)  ERRNS=ABS{V(I)-V2(I)) 

IF  (V2{I) .EO.NINES)  ERRNS=ABS(V(I)-V1(I) ) 

IF  {ERRHS.LT.5.0)  ERRNS=5.0 

IF  (ERRNS.GT.50.0)  ERRNS=0.0  !NO  ERROR  CALCULATED  -  NO  ERROR  BAR 
A(I,11)=ERRNS 

A|I.25)=SORT( (ERREW*COS57»SINZEN)»»2*{ERRNS*COS33»SINZEH)"2) 

A  { 1 , 2 7 ) =SORT ( { ERREW* COS 33* S INZEH ) • • 2* ( ERRNS • COS 57 • S INZEN ) • • 2 ) 
ERR=HALF* 100 . 0* ABS ( W1 { I ) -W2 ( I ) ) 

IF  (Will) .EO.NINES)  ERRW=ABS(W{I)-W2|I)) 

IF  (W2( I) .EO.NINES)  ERRW=ABS (W{ I )-Wl( I } ) 

IF  IERRW.GT.900.0)  ERRW=0.0  !NO  ERROR  CALCULATED  -  NO  ERROR  BAR 
A(I,12)=100,0»W(I) 

A(I, 13)=ERRW 
2  CONTINUE 
RETURN 
END 

SUBROUTINE  IDI  (U.V.W) 


IDI  WIND-CALCUUTION  PROGRAM;  MAPSTAR  RADAR 
COPYRIGHT  1993,  HOLODYNE  LIMITED  1986. 

ALL  RIGHTS  RESERVED. 
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MAC  VERSION  2.00 

MAV  2.  1993. 

THIS  PROGRAM  WILL  CALCULATE  WIND  PROFILES  IN  1-KM  STEPS.  WITH 
SMOOTHING.  FROM  REGULAR  SCATTERING-POINT  PARAMETER  HEIGHT 
PROFILE  FILES.  TYPE  SPP  -  GR  XXI 

CURRENTLY  SET  UP  FOR  69-lllKM  (15  HEIGHTS);  NEED  TO  CHANGE  IH 
DIMENSION  OF  SPPZ( IH. I . J) .  AND  SOME  CODE,  TO  MATCH  HEIGHT  RANGE. 
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THE  SCATTERING-POINT  PARAMETERS  ARE  : 

1.  ALTITUDE  (KM). 

2.  RADIAL  VELOCITY  (M/SEC) . 

3.  ZENITH  ANGLE  IN  EAST-WEST  MERIDIAN  (DEGREES). 

4.  ZENITH  ANGLE  IN  NORTH-SOUTH  MERIDIAN  (DEGREES). 

5.  VOLTAGE  AMPLITUDE  ON  #1  DIPOLES. 

6.  PHASE  OF  *1  DIPOLES  (DEGREES). 

7.  VOLTAGE  AMPLITUDE  ON  #2  DIPOLES. 

8.  PHASE  OF  #2  DIPOLES  (DEGREES). 

9 .  SPARE 

10 .  SPARE 

EXPLANATION  OF  EASILY-REPROGRAMMED  PARAMETERS  (JUST  CHANGE  THE  SOURCE00001240 

CODE  VALUE  GIVEN  BELOW:  00001241 

VMAX  IS  THE  LARGEST  ALLOWED  HORIZONTAL  VELOCITY.  WE  TEST  EACH  POINT00001242 

AGAINST  VMAX  BY  PROJECTING  ITS  RADIAL  VELOCITY  INTO  THE  HORIZONTAL  00001243 

PLANE.  AND  REJECT  IT  IF  IT‘S  BIGGER  THAN  VMAX.  00001244 

THMAX  IS  THE  LARGEST  ACCEPTABLE  RADIAL  ZENITH  ANGLE.  00001245 

THMIM  IS  THE  SMALLEST  ACCEPTABLE  RADIAL  ZENITH  ANGLE.  00001246 

MINH,  MINV  ARE  THE  MINIMUM  NUMBER  OF  POINTS.  IF  THERE  ARE  NOT  00001247 

SUFFICIENT  POINTS.  THAT  ALTITUDE  IS  SKIPPED.  00001248 

NSIGMA  IS  THE  MAXIMUM  NUMBER  OF  STANDARD  DEVIATIONS  FROM  THE  FIT  AN00001249 

INDIVIDUAL  POINT  CAN  LIE  WITHOUT  BEING  REJECTED  FROM  THE  VELOCITY  00001250 

CALCULATION.  00001251 

ZMIN  IS  THE  BOTTOM  ALTITUDE  FOR  WHICH  WINDS  ARE  TO  BE  CALCULATED.  00001252 
ZMAX  IS  THE  TOP  ALTITUDE  FOR  WHICH  WINDS  ARE  TO  BE  CALCULATED.  00001253 
WIND  CALLS  INNAME,  OUTNAME,  WFV.  WFH.  PHFIT  AND  SORT.  00001254 

REALM  PI.VMAX,THMAXV,U(50),V(50).W(50),TRP(50).SUCKS(8),  00001255 

1  LINE{10).RMSDVR(50).COSL(2300).COSM{2300).COSN{2300),  00001256 

2  DVR(2300), SLOPE. INTERCEPT. VRAD(17)  00001257 

INTEGER*  4  RE J ( 4 ) . IH . PARAMETER . TESTFUG . POINT , NPROFS . NHI TES , EARLY .  00001258 

1  NPOINTS(50) .HOWLONG, BIGTIME, NPV.NPVO.FITFLAG. MISS, NBAD.  00001259 

2  YEAR. MONTH.OAY. HOUR. MINUTE. MINH.MINV, MSEC, lO.NGO.NFILE.  00001260 

3  NUMRAD(17).MY.MO.JO.LTIMH,LTIMM,NOW.NOWSTART.NOWEND  00001261 

CHARACTER*40  INFILE  00001262 

CHARACTER* 40  OUTFILE  00001263 

CHAHACTEB*27  INPATH  00001264 

character* 19  OUTPATH  00001265 

.iiACTER*  10  TUREKTIME  00001266 

CHARACTER* 6  STATE  00001267 

CHARACTER* 1  POLAR  00001268 

COMMON  /WINDl/  SPP( 2300, 7) ,SPPZ( 15, 2300, 7)  00001269 

COMMON  /WIND2/  Z.TRP, REJ, LINE, WIDTH( 50) , IWT( 2300) .  00001270 

2  RMSDVR{50) ,COSL.COSM,COSK,DVR.NUMRAO.VRAD  00001271 

COMMON  /WIND3/  PI, VMAX. THMAXH.THMINH.THMAXV.THMINV, MINH, MINV,  00001272 

1  NSICaiA.TESTFLAG.IH.NPOINTS. INFILE. OUTFILE. INPATH,  00001273 

2  OUTPATH. NPH.NPV.NPVO, SLOPE. INTERCEPT. FITFLAG  00001274 

COMMON  /SPPFILE/  IFILE.NFILE, POLAR  00001275 

COMMON  /TIMER/  INTNUM. YEAR, MONTH, DAY.HOUR. MINUTE, TUREKTIME,  00001276 
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o  o  r>  o  n 


•HOWLONG.NOW 

C 

PI  =  3.14159265 
NTOTAL=0 
VRMAl  =  60 
VMAX  =  200 
THMAXH  =  16 
THMINH  =  3 
THMAXV  =  5 
THMINV  =  0 
THMIN  =  0 
MINH  =  5 
MIKV  =  5 
NSIGMA  =3.0 
DO  20000  1=1.8 
SUa(S{I)=999.0 
20000  CONTINUE 

668  LOOP=0 
C 

669  IFILE=NniJ:-l 

PROGRAM  ACCEPTS  SPP  DATA  OVER  3KH  HEIGHT  RANGE  FOR  EACH  ALTITUDE 
AND  LOOPS  THREE  TIMES  THROUGH  SPP  DATA  TO  PRODUCE  OUTPUT  AT  IKM 
HEIGHT  INTERVALS.  ZMIN,  ZMAZ  ARE  ADJUSTED  ACCORDINGLY. 

LOOP=LOOP*l 
IF  (LOOP.EO.l)  THEN 
STATE=" REWIND" 

ZMIN  =67.5 
ZMAI  =  112.5 
END  IF 

IF  (L00P.E0.2)  THEN 
STATE="APPEHD" 

ZMIN  =68.5 
ZMAX  =  110.5 
END  IF 

IF  {L00P.E0.3J  THEN 
STATE="APPEHD" 

ZMIN  =69.5 
ZMAX  =  111.5 
END  IF 

NHITES=(ZMAX-ZMIN)/3.0*0.1 
NGO=0 
GO  TO  203 


RETURN  HERE  FOR  NEW  INPUT  FILE 


20203  NGO=l 

203  CALL  INNAME 

WRITE  ( • . • )  ■ INFILE  =  ‘ , INFILE 
NERR=1 

OPEN  ( 18.ERR=90909.FILE=INFILE.STATUS=- OLD’ . IOSTAT=IO. 
•FORM*  UNFORMATTED’ J 

20100  READ  (18.ERR=90909.IOSTAT=IO,END=20203)  ( LINE ( PARAMETER ) . 
•PARAMETER=1,10) 

IF  (LINE(l)  .GT.  -990.0)  GO  TO  20100 
WRITE  (*,100)  (LINE{KK).KK=1,10) 

100  FORMAT  {10F8.0) 


00001277 

00001278 

00001279 

00001280 

00001281 

00001282 

00001283 

00001284 

00001285 

00001286 

00001287 

00001288 

00001289 

00001290 

00001291 

00001292 

00001293 

00001294 

00001295 

00001296 

00001297 

00001298 

00001299 

00001300 

00001301 

00001302 

00001303 

00001304 

00001305 

00001306 

00001307 

00001308 

00001309 

00001310 

00001311 

00001312 

00001313 

00001314 

00001315 

00001316 

00001317 

00001318 

00001319 

00001320 

00001321 

00001322 

00001323 

00001324 

00001325 

00001326 

00001327 

00001328 

00001329 

00001330 

00001331 

00001332 

00001333 

00001334 
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lff=LINE(2) 

MOLINE  (  3) 

J0=LINE(4) 

LTIMH=LINE(5) 

LTIMM=LINE{6) 

MSEC=LINE(7) 

NOWTIME=  LTIMM*LTIMH*  60* JO*  24 • 604MO*  30*24  *  60 
REWIND  (18) 

IF  (NGO.EQ.l)  GO  TO  20103 


SET  UP  OUTPUT  FILE 


20101  NERR=2 

IF  ( MONTH. EO.O)  GO  TO  90909 
NPROFS=0 

BIGTIME  =  MINUTE*H0UR*60+DAY*24*60*MONTH*30*24*60 
NOWSTART=BIGTIME-HOWLONG/ 2 
IF  (NGO.EQ.l)  GO  TO  670 

EARLY= ( HOUR*  24  * | DAY+MONTH*  30  > ) - ( LTIMH»24 • ( JO*MO*  30  > ) 

IF  (EARLY.GT.3)  THEN 

WRITE  (*,*)  ••  SPP  FILE  CHOICE  EARLY  BY  ".EARLY,"  HOURS" 
WRITE  { * . * )  "  NEED  TO  ENTER  UTER  SPP  FILE  NUMBER- 
CLOSE  (18) 

READ  {*,*)  NFILE 
GO  TO  668 
END  IF 

IF  { NOWTIME. GT.NOWSTART)  THEN 

WRITE  (*,*)  "  BAD  CHOICE  OF  SPP  INPUT  FILE;  NOWSTART 
WRITE  (*.*)  ■'  NOWTIME 

WRITE  ( • .  * )  ••  RE-ENTER  SPP  INPUT  FILE  NUMBER" 

CLOSE  (18) 

READ  (*.*)  NFILE 
GO  TO  668 
END  IF 

670  NOWEND=NOWSTART*HOWLONG 
CALL  OUTNAME 
NERR=3 

WRITE  (*.*)  "  " 

WRITE  ( • . • )  • OUTFILE  =  ' , OUTFILE 
OPEN  (16.ERR=90909.FILE=OUTFILE.POSITION=STATE,IOSTAT=IO, 
*FORM="FORMATTED" ) 


10100  DO  10101  IH  =  l.NHITES 
NPOINTS(IH)=0 

U(IH)  =  0.0 
V(IH)  =  0.0 
W(IH)  '  0.0 
TRP(IH)  =0.0 
RMSDVR(IH)  =0.0 

10101  CONTINUE 
IH=0 
MISS=0 
NBAD=0 

DO  10102  IREJ=1,4 
REJ{IREJ)  =  0 

10102  CONTINUE 
20102  WRITE  (*,90003) 

90003  FORMAT 

1  (IX.'  ALT  U  V  W 


00001335 
00001336 
00001337 
00001338 
00001339 
00001340 
00001341 
00001342 
00001343 
00001344 
00  00  1  34  5 
00001346 
00001347 
00  00  1  34  8 
00001349 
00001350 
00001351 
00001352 
00001353 
00001354 
00001355 
00001356 
00001357 
00001358 
00001359 
00001360 
00001361 
.NOWSTART  00001362 
.NOWTIME  00001363 
00001364 
00001365 
00001366 
00001367 
00001368 
00001369 
00001370 
00001371 
00001372 
00001373 
00001374 
00001375 
00001376 
00001377 
00001378 
00001379 
00001380 
00001381 
00001382 
00001383 
00001384 
00001385 
00001386 
00001387 
00001388 
00001389 
00001390 
00001391 

TRP  NTOT  NPV  NPH  RATE' ,  00001392 


Cl  o  o 


2  SLOPE  INTERCEPT' ) 

20103  NERR=4 

READ  (18.ERR=90909.IOSTAT=IO.END=20203)  { LIKE ( PARAMETER ) . 
•PARAMETER=1. 10) 

IF  (LINE(l)  .GT.  -990.0)  GO  TO  20103 


•  RETURN  TO  HERE  FOR  NEW  PROFILE  . 


20133  MY=LINE(2| 

MO=LINE(3) 

JO=LINE(4) 

LTIMH=LINE(5) 

LTIMM=LINE|6) 

MSEC=LINE(7) 

NOWTIME=  LTIMM+LTIMH*  60* JO»24»  60*MO*  30*24*  60 
IF  ( NOWTIME. LT.MOWSTART)  GO  TO  20103 
IF  ( NOWTIME. GT.NOWEND)  THEN 
BACKSPACE  (18) 

GO  TO  20204 
END  IF 

NPROFS=NPROFS*l 

NERR=5 

READ  (18.ERR=90909.IOSTAT=IO.END=20203)  ( LINE ( PARAMETER ) . 
*PARAMETER=1. 10) 

IF  (LINE{1)  .LT.  -990.0)  THEN 
NPROFS=MPROFS-l 
GO  TO  20133 
END  IF 


TEST  THE  POINT  FOR:  ALTITUDE 


20202  IF  |LINE(1)  .LT.  ZMIN)  THEN 
NERR=6 

READ  (18.ERR=90909.IOSTAT=IO.END=20203)  ( LINE ( PARAMETER ) . 
*PARAMETER=1, 10) 

IF  (LINE(l)  .LT.  -990.0)  GO  TO  20133 

GO  TO  20202 

ENDIF 

IF  (LINE(l) .GT.ZMAI)  GO  TO  20103 
INDEX= ( LINE ( 1 ) -ZMIN ) / 3 . 0* 1 . 0 

IF  (NPOINTS( INDEX)  .GT.  2300)  GO  TO  20104  ! THERE  ARE  TOO  MANY 


C 

C  TEST  FOR: 

C 

C 

C 

C 

C 

c 


(1)  PROJECTED  HORIZONTAL  VELOCITY  >  VMAX, 

(2)  RADIAL  VELOCITY  =  0 

(3)  RADIAL  VELOCITY  >  VRMAl 
(3)  POLARIZATION 


TESTFLAG  =  1 

COSZAX  =  SORT(1.0-(SIN(LINE(3)*PI/180.0))**2 
1  -  (SIN{LINE(4)*PI/180.0))**2) 

ZAX=ACOS( COSZAX) 

SINZAX=SIN(ZAX) 

IF  (SINZAX  .GT.  0.02)  THEN 
VHORIZ=ABS { LINE { 2 ) / S INZAX ) 

IF(VHORIZ  .GT.  VMAX)  THEN 
REJ(l)  =  REJ(l)  ♦  1 


00001393 
00001394 
00001395 
00001396 
00001397 
00001398 
00001399 
00001400 
00001401 
00001402 
00001403 
00001404 
00001405 
00001406 
00001407 
00001408 
00001409 
00001410 
00001411 
00001412 
00001413 
00001414 
00001415 
00001416 
00001417 
00001418 
00001419 
00001420 
00001421 
00001422 
00001423 
00001424 
00001425 
00001426 
00001427 
00001428 
00001429 
00001430 
00001431 
000014  32 
00001433 
00001434 
00001435 
00001436 
00001437 
00001438 
00001439 
00001440 
00001441 
00001442 
00001443 
00001444 
00001445 
00001446 
00001447 
00001448 
00001449 
00001450 
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ooo  1-0  oo  oo  ooonoo 


► 


TESTFLAG  =  0 
ENDIF 

►  EMDIF 

IF  (LIf(E(21  .EQ.  0)  THEN 
REJ(2(  =  HEJ<2)  *  1 
TESTFLAG  =  0 
ENDIF 

IF  (ABS(LINE(2) )  .GT.  VRMAX)  THEN 
REJ( 3)=REJ( 3)»1 

►  TESTFLAG  =  0 
ENDIF 

DETERMINE  POLARIZATION 
ANGLE=LINE(6)-LINE(8) 

IF  (POLAR.EO.'A")  GOTO  10201 
IF  (POLAR.EO.'L")  THEN 
IF  {ABSfANGLE) .LT.45.0)  GO  TO  10201 

IF  (ABS(ANGU)  .GT. 135.0. AND. ABS(AMGLE)  .LT. 225.0)  GO  TO  10201 
IF  (ABS(ANGLE) .GT. 315.0. AND. ABS(ANGLE) .LT. 360.0)  GOTO  10201 
GO  TO  10200 
END  IF 

IF  (POLAR. EO, "I")  THEN 

IF  (ANGLE. GT. -135.0. AND. ANGLE.lt. -45.0)  GO  TO  10201 
IF  (ANGLE. GT. 225.0. AND.ANGLE.lt. 315.0)  GO  TO  10201 
GO  TO  10200 
END  IF 

IF  (POLAR.EQ.'O")  THEN 

IF  (ANGLE. GT. 45.0. AND. ANGLE.lt. 135.0)  GO  TO  10201 
IF  (ANGLE. GT. -315.0. AND. ANGLE.lt. -225.0)  GO  TO  10201 

0200  TESTFLAG=0 

R£J(4)=R£J(4)«1 
END  IF 

CHECK  FOB  TOO  MANY  POINTS 

1020 1  NPOINTS ( INDEX ) ^NPOINTS ( INDEX ) 4 1 

IF  (NPOINTS (INDEX)  .EQ.  2300)  THEN 

WRITE  (*.•)  THANKS  ANYHOW.  BUT  IVE  ALREADY  GOT  2300  POINTS. 
GO  TO  20104 

k  ENDIF 

IF  (TESTFLAG  .EO.  1)  THEN 
DO  10202  PARAMETER  *  1,7 

SPPZ ( INDEX , NPOINTS ( INDEX ) . PARAMETER )  =  LINE ( PARAMETER ) 

10202  CONTINUE 

TRP(INDEX)  =  TRP(INDEX)  4  LINE(5)"2  4  LINE(7)*»2 
ENDIF 

►  20104  NERR=7 

READ  (18,ERR=90909.IOSTAT=IO.END=20203)  ( LIKE ( PARAMETER ) . 
*PARAMETER=1. 10) 


00001451 
00001452 
00001453 
000014  54 
00001455 
00001456 
00001457 
00001458 
00001459 
00001460 
00001461 
00001462 
00001463 
000014  64 
00001465 
00001466 
00001467 
00001468 
00001469 
00001470 
00001471 
00001472 
00001473 
00001474 
00001475 
00001476 
00001477 
00001478 
00001479 
00001480 
00001481 
00001482 
00001483 
00001484 
00001485 
00001486 
00001487 
00001488 
00001489 
00001490 
00001491 
00001492 
00001493 
00001494 
00001405 
00001496 
00001497 
00001498 
00001499 
00001500 
00001501 
00001502 
00001503 
00001504 
00001505 
00001506 
00001507 
00001508 
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IF  (LINE(l)  .LT.  -990.0)  GO  TO  20133 
GO  TO  20202 

20204  IH=IH*l 
FITFLAG  =  1 

IF  (IH.GT. WHITES)  GO  TO  20206 
Z=ZMIN* 1 . 5+  3 . 0* ( FLOAT ( IH- 1 ) ) 

IF  (NPOINTS{IH) .EO.O)  THEH 
MISS=MISS*1 
GO  TO  20250 
END  IF 

DO  2  POINT=l.NPOINTS(IH) 

DO  2  PAJIAMETER=1.  7 

S  PP ( POINT , PARAMETER ) =SPPZ ( IH . POINT . PARAMETER ) 

2  CONTINUE 

C 

C  FIT  THE  SCATTERING  POINTS  IN  THIS  WINDOW  WITH  A  3- VECTOR. 

C 

20205  CALL  wrV(U.V.W) 

IF  {FITFLAG  .EO.  0)  THEN 
NBAO=NBAO« 1 

WRITE  (•.•)  VERTICAL  FAILURE  AT  ' . IH.NPOINTS ( IH) ,2 
WRITE  (16,90002)  Z.  (SUaCS|KKj  .JaC=l.  8) 

GO  TO  20204 
ENDIF 

CALL  WFHIU.V.W) 

IF  (FITFUG  .EO.  0)  THEN 
NBAO=NBAO« 1 

WRITE  (',•)  HORIZONTAL  FAILURE  AT  ' .IH.NPOINTS (IH) .Z 
C 

C  WRITE  FLAG  RECORD  FOR  THIS  ALTITITOE  (  U  =  999.0  ) 

C 

202S0  WRITE  (16,90002)  Z. (SUCKS(]aC) .KX=1, 8) 

GO  TO  20204 
C 

C  WRITE  GOOD  VELOCITY 
C 

ELSE 

IF  (TRP(IH)  .LT.  1)  THEN 

TRP(IH)  =  0 

ELSE 

TRP(IH)  *  10*LOG10(TRP(IH)) 

ENDIF 
ENDIF 
CALL  PHFIT 

RATE  =  FLOAT(NPOINTS(IH) )/NPROFS 
WRITE  (*,90001) 

1  Z . U( IH ) . V ( IH) . W ( IH ) , TRP ( IH ) , NPOINTS ( IH ) . NPV . NPH . RATE . 

2  SLOPE. INTERCEPT 

90001  FORMAT  ( 1I.F4 .0. 2( 11. F6, 1) . 2( lE.FS. 1) . 3( IX. 14 ) . 3( 1X.F5. 1) ) 
XI  =  FLOAT(NPOINTS(IH)) 

X2  =  FLOAT (NPV) 

X3  =  FLOAT(NPH) 

WRITE  (16,90002) 

1  Z.U(IH).V(IH).W(IH).TRP(IH),X1.RATE, 

2  SLOPE, INTERCEPT 

90002  FORMAT  (9{E13.4)) 

GO  TO  20204 

C 


00001509 
00001510 
00001511 
00001512 
00001513 
00001514 
00001515 
00001516 
00001517 
00001518 
00001519 
00001520 
00001521 
00001522 
00001523 
00001524 
00001525 
00001526 
00001527 
00001528 
00001529 
00001530 
00001531 
00001532 
00001533 
00001534 
00001535 
00001536 
00001537 
00001538 
00001539 
00001540 
00001541 
00001542 
00001543 
00001544 
00001545 
0000154  6 
00001547 
00001548 
00001549 
00001550 
00001551 
00001552 
00001SS3 
00001554 
00001555 
00001556 
00001557 
00001558 
00001559 
00001560 
00001561 
00001562 
00001563 
00001564 
00001565 
00001566 
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I 


C  ITS  NOT  TIME  TO  QUIT:  OUTPUT  REJECTION  STATS  TO  SCREEN.  DATA 

C  STATS  TO  WIND.TXT.  AND  GO  SET  UP  NEXT  OUTFILE 

C 

20206  CLOSE  ( 16) 

IF  (NBAD.EQ.NHITES)  THEN 
WRITE  (*.90004) 

90004  FORMAT  (1X/5X,'  BAD  DATA  THIS  INTERVAL"./) 

END  IF 

IF  (MISS .EO.NHITES)  THEN 
WRITE  {*. 90005) 

90005  FORMAT  (1X/5X."  NO  DATA  THIS  INTERVAL",/) 

GO  TO  90910 

ELSE 


00001567 

00001568 

00001569 

00001570 

00001571 

00001572 

00001573 

00001574 

00001575 

00001576 

00001577 

00001578 

00001579 


WRITE  (*,*)  REJECTIONS: 

WRITE  (*.•)  ■  VMAX  VR=0  VRMAX  POLAR 
WRITE  (*.102)  (REJ(IREJ) .IREJ=1,4) 

102  FORMAT  (318. IX. 18) 

GO  TO  90910 
END  IF 
C 

C  TOO  BAD  -  ERROR  EXIT 
C 

90909  WRITE  (*.*)  '  ERROR  EXIT  AT  NERR  =  ' .NERR. ’  STATUS  =.IO 
GO  TO  90950 

C 

90910  IF  (LOOP.LT.3)  THEN 

IF  (IFILE.EO.NFILE)  CLOSE  (18) 

GO  TO  669 
END  IF 
C 

CALL  REORDER  (U.V.W) 

C 

C  LOOKS  LIKE  WE  MAY  HAVE  SOME  WINDS! 

C 

90940  WRITE  (*.*)  '  SUCCESSFUL  RUN' 

90950  CLOSE  (15) 

CLOSE  (16) 

CLOSE  (17) 

CLOSE  (18) 

RETURN 

END 

SUBROUTINE  INNAME 
C 

C  INNAME  CREATES  SPP  INPUT  FILENAME  "SPP  -  GR  XXX" 

C 


00001580 

00001581 

00001582 

00001583 

00001584 

00001585 

00001586 

00001587 

00001588 

00001589 

00001590 

00001591 

00001592 

00001593 

00001594 

00001595 

00001596 

00001597 

00001598 

00001599 

00001600 

00001601 

00001602 

00001603 

00001604 

00001605 

00001606 

00001607 

00001608 

00001609 

00001610 

00001611 


c 


c 


CHARACTER*40  INFILE. OUTFILE  00001612 

CHARACTER'27  INPATH. OUTPATH  00001613 

CHARACTER* 1  FKUM{ 3)  00001614 

cormow  /WIND3/  PI.VMAI.THMAXH.THMINH.THMAXV.THMINV.MINH.MINV.  00001615 

1  NSIGMA.TESTFLAG.IH.KPOINTS{ 50). INFILE. OUTFILE. INPATH.  00001616 

2  OUTPATH.NPH.NPV.NPVO. SLOPE. INTERCEPT. FITFLAG  00001617 

COMMON  /SPPFILE/  IFILE.NFILE  00001618 

00001619 

1  IFILE=IFILE+1  00001620 

SKIP=0  00001621 

CALL  IBAD  (IFILE.SKIP)  00001622 

IF  (SKIP.EO.l)  GO  TO  1  00001623 

I100=IF1LE/100  00001624 
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I10=IFILE/ 10-10*1100 
I1=IFILE-100*I100-10*I10 
FNUM(1)=CHAR( 1100*48) 
FmJM(2)=CHAR(I10*48) 

FNUM( 3)=CHAR( 11*48) 

INPATH  =  MAITOlieOO  ;  IMFIL£S;SPP  -  GR 
WRITE  (INFILE, 90003)  INPATH, FNUM 
90003  FORMAT  (A27. 3A1) 

RETURN 

END 

SUBROUTINE  OUTNAME 


C 

C 

C 


OUTNAME  CREATES  IDI  WINDS  OUTPUT  FILENAME  "ZXXXXIXX .MAW' 

CHARACTER* 2  ASCMONTH, ASCDAY.ASCHOUR, ASCMINUTE 
CHARACTER* 40  INFILE. OUTFILE 
CHARACTER* 27  INPATH. OUTPATH 
CHARACTER* 10  TUREKTIME 

INTEGER* 4  INTNUM . YEAR . MONTH . DAY . HOUR . MINUTE . HOWLONG . NOW 
COMMON  /WIND3/  PI.VMAI.THMAIH.THMINH.THMAXV.THMINV.MINH.MINV, 

1  NSIGMA, TESTFLAG, IH. NPOINTS | 50 ) . INFILE . OUTFILE , INPATH . 

2  OUTPATH . NPH . NPV . NPVO . SLOPE . INTERCEPT . FITFLAG 
COMMON  /TIMER/  INTNUM, YEAR. MONTH, DAY. HOUR. MINUTE. TUREKTIME. 

•HOWLONG. NOW 


IF  (MONTH  .LT.  10)  THEN 

WRITE  (ASCMONTH. 90001)  O'.M/MfTH 

90001  FORMAT  (Al.Il) 

ELSE 

WRITE  (ASCMONTH. 90002)  MONTH 

90002  FORMAT  (12) 

ENDIF 

IF  (DAY  .LT.  10)  THEN 

WRITE  (ASCDAY. 90001)  O'. DAY 

ELSE 

WRITE  (ASCDAY. 90002)  DAY 
ENDIF 

IF  (HOUR  .LT.  10)  THEN 

WRITE  (ASCHOUR. 90001)  O'. HOUR 

ELSE 

WRITE  (ASCHOUR, 90002)  HOUR 
ENDIF 

IF  (MINUTE  .Lf.  10)  THEN 

WRITE  (ASCMINUTE, 90001)  O'. MINUTE 

ELSE 

WRITE  (ASCMINUTE, 90002)  MINUTE 
ENDIF 

OUTPATH  =  MAITOROOOrOUTFILES: • 

WHITE  (OUTFILE, 90003) 

1  OUTPATH, ASCMONTH, ASCDAY, ASCHOUR. ASCMINUTE. ' .MAW 

90003  FORMAT  (A19.4A2,A4) 

RETURN 

END 

SUBROUTINE  WFV(U.V,W) 

C 

C  THIS  SUBROUTINE  CALCULATES  THE  VERTICAL  WINDS  FROM  MAPSTAR  SPPS . 
C  AUGUST  17.  1990 
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^  CHARACTER*  1  POUR 

^  CHARACTER*40  INFILE.OUTFILE 

CHARACTER* 27  INPATH 
character* 19  OUTPATH 
CHARACTER* 10  TUREKTIME 
DIMENSION  A(3.3),WINDV(3) 

REAL*4  SIGMA.SIGMAUST.PI.U{50),V(50)  50) 

•  INTEGER* 4  FUG.I2A 

INTEGER* 4  REJ.IH.POIN)  NPOINTSj 50) .HOWLONG.NPV.NPVO. TESTFUG. 
IFI TFUG . MINH . MINV . NUMRAD . TEAR . MONTH . DAY , HOUR . MINUTE . NOW 
COMMON  /WINDl/  SPP( 2300. 7) . SPPZ( 15. 2300. 7) 

COMMON  /WIND2/  Z.TRP(50), 

1  REJ(4).LINE(10). 

^  2  WIDTH(50).IWT(2300).BMSDVR(50). 

•  4  COSL{2300).COSM{2300).COSNi2300).DVR(2300). 

5  NUMRAD(17).VRAD(17) 

COMMON  /W1ND3/  PI .VMAI.THMAIH.THMINH.THMAIV.THMINV. MINH. MINV. 

1  MS  IGMA .  TESTFUG .  IH ,  NPOINTS .  INFI LE .  OUTFI LE . 

2  INPATH, OUTPATH, NPH.NPV.NPVO. SLOPE. INTERCEPT. FITFUG 
COMMON  /SPPFILE/  IFILE.NFILE.POUH 

•  COMMON  /TIMER/  INTNUM. YEAR. MONTH, DAY. HOUR. MINUTE. TUREKTIME. 

*HOWLONG.NOW 

C 


DO  10101  lA  =  1.3 
WIMDV{IA)  =0.0 
DO  10101  IB  =  1,3 
A(lA.IB)  =  0.0 
^  10101  CONTINUE 

DO  10102  II  =  1,17 
NUMRAD(II)  =  0 
VRAD(II)  =  0 
10102  CONTINUE 

NPV  =  NPOINTS (IH) 

•  DO  10201  POINT  =  1. NPOINTS (IH) 

IWT( POINT)  =  1 

SINZAX  =  SORT(SIN(SPP(POINT.3)*PI/180)**2 
1  ♦  SIN(SPP(POINT,4)*PI/180)**2) 

IF  ((SINZAX  .LT.  SIN(THMINV*PI/180) )  .OR. 

1  (SINZAX  .GT.  SIN(THMAIV*PI/180)))  THEN 

IWT( POINT)  =  0 

•  NPV  =  NPV  -  1 

IF  (NPV  .LT.  MINV)  THEN 

FITFLAC  =  0 

GO  TO  90909 

ENDIF 

ENDIF 

A  COSL(POINT)  =  SIN(SPP(POINT,3)*PI/180) 

COSM(POINT)  =  SIN{SPP(POINT,4)*PI/180) 

COSN(POINT)  =  SORT(l  -  COSL(POINT)**2  -  COSM(POINT) **2) 
10201  CONTINUE 

SIGMALAST  =  1E8 
20001  FUG  =  0 

DO  103^1  POINT  =  1. NPOINTS (IH) 

•  IF  (IWT(POINT)  .EO.  0)  GO  TO  10301 

A(l.l)  =A(1.1)  +  COSL(POINT)**2 

A(1.2)  =A(1.2)  +  COSL(POINT)»COSM(POINT) 
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A(1.3)  =  A(1.3)  +  COSL( POINT )*COSN( POINT) 

A(2.2)  =  A(2.2)  ♦  COSM{POINT)‘*2 

A(2.31  =  A(2.3)  »  COSM(POINT)*COSN(POINT) 

A(3.  3|  =  A(3. 3)  ♦  C0SN(P0INT)**2 

WINDV{1)  =WINDV(1)  ♦  SPP( POINT, 2 )*COSL( POINT) 

WINDVi2)  =  WINDV(2)  ♦  SPP(POINT,2)*COSM(POINT) 

WINDV{3)  =  WINDV(3)  ♦  SPP( POINT. 2) ‘COSNJ POINT) 

10301  CONTINUE 

Ai2.1)  =  All. 2) 

A13.  1)  =  A(  1.3) 

A(3.2)  =  A(2.3) 

DET  =  A(1.1)*A(2.2)'A(3. 3)  ♦  2»A( 1. 3) •A(2, 3)  - 
1  A(  I,  1)*A(2,  3)"2  -  A(2.2)»A(1.3)*»2  -  A(  3.  3) 'Al  1 . 2)  •  •  2 

IF  (ABS(DET)  .LT.  l.OE-7)  THEN 
WRITE  {*.*)  WFV:  NO  SOLUTION' 

FITFLAG  =  0 
GO  TO  90909 
ENDIF 

U(1H)  =  (WINDV(1)*(A(2.2)‘A(3.3)-  A(2,3)**2)  ♦ 

1  WINDV(2)*(A(2.3)*A(1.3)  -  A( 1 . 2) ‘Al 3. 3) )  ♦ 

2  WINDV(3)*{A<1.2)*A(2.3)  -  A( 1. 3) ‘AI 2. 2) ) ) /DET 
V(IH)  =  (WINDV(1)»(A(2.3)*A(1.3)  '  A( 1, 2)*A( 3, 3) )  + 

1  WINDV(2)*(A(1. 1)*A(3.3)  -A(l,3)‘*2)  ♦ 

2  WINDV(3)*(A|1.3)‘A(1.2)  -  A( 1. 1) •A(2, 3) ) ) /DET 
W(IH)  =  (WINDV|1)*{A(1.2)*A(2.3)  -  A( 1. 3) •A(2, 2) )  ♦ 

1  WINDV{2)*(A(1.2)*A|1,3)  -  A| 1. 1) ‘AI 2, 3) )  + 

2  WINDV(3)*(A(1.1)*A(2.2)  -  A| 1.2)**2) )/DET 

C  CALCULATE  THE  STANDARD  DEVIATION  (SIOIA) 

ERRORSUM  =  0 

DO  10401  POINT  *  l.NPOINTS(IH) 

IF  (IWT{POINT)  .EO.  0)  GO  TO  10401 

DVR (POINT)  =  SPP(POINT.2)  -  U{IH)*COSL( POINT) 

1  -  V(IH)»COSM(rOINT)  -  W(IH)*COSN( POINT) 

ERRORSUM  =  ERRORSUM  ♦  DVR(POINT)*»2 
10401  CONTINUE 

SIGMA  =  SORT ( ERRORSUM/ NPV) 

DO  10501  POINT  =  l.NPOINTS{IH) 

IF  (IWT( POINT)  .EO.  0)  GO  TO  10501 

IF  (ABS(DVRIPOIMT))  .GT.  NSIGMA’SIGMA)  THEN 

IWT( POINT)  =  0 

FLAG  =  1 

NPV  =  NPV  -  1 

IF  (NPV  .LT.  MINV)  THEN 

FITFLAG  =  0 

GO  TO  90909 

ENDIF 

ENDIF 

10501  CONTINUE 

IF  (FLAG  .EO.  0)  GO  TO  20002 
IF  (FLAG  .EO.  1)  THEN 

IF  (SIGMA  .GE.  0.999*SIGMALAST)  GO  TO  20002 
IF  (SIGMA  .LE.  0.01)  GO  TO  20002 
SIGMALAST  =  SIGMA 
GO  TO  20001 
ENDIF 

C  GOOD  VELOCITY . 

20002  IF  (  (ABS(U(IH))  .GT.  VMAX)  -OR. 

1  (ABS(V(IH))  .GT.  VMAX)  .OR. 
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2  !ABS(W(IH))  .GT.  VMAX/10.0)  )  THEN 
WRITE  (*.•)  IH.  U.  V.  W  = 

FITFLAG  =  0 
GO  TO  90909 
ENDIF 

IF  (FITFLAG  .EO.  1)  THEN 
RMSDVR(IH)  =  0 

DO  10601  POINT  =  l.NPOINTS(IH) 

IF  (IWT( POINT)  .EQ.  0)  GO  TO  10601 

DVR (POINT)  =  SPP(POINT.2)  -  U( IH) *COSL( POINT) 

1  -  V(IH)*COSM( POINT)  -  W(IH)«COSN( POINT) 

RMSDVR(IH)  =  RMSDVR(IH)  *  DVR(POINT)**2 
ZA  =  { 180/PI)*ASIN(SQRT{ l-COSN(POINT)**2) ) 

IZA  =  INT{ZA)  ♦  1 

IF  (IZA  .GT.  17)  THEN 

WRITE  { • .  • )  ' IZA  =  ■ . IZA 

FITFLAG  =  0 

GO  TO  90909 

ENDIF 

IF  (IZA  .EQ.  17)  IZA  =  16 
VRAD{IZA)  =  VRADIIZA)  ♦  DVR(POINT)**2 
NUMRAD(IZA)  =  NUMRAD(IZA)  ♦  1 
10601  CONTINUE 

IF  (NPV  .GT.  0)  THEN 
RMSDVR(IH)  =  SORT (RMSDVR(IH)/ NPV) 

DO  10701  lALPHA  =  1. 16 
IF  (NUMRAD(IALPHA)  .EO.  0)  GO  TO  10701 
C  WRITE  (•,')  ■ZA.VRAD.NUMRAD=  ' .lALPHA.VRAD(IALPHA) .NUMRAD(IALPHA) 
VRAO{IALPUA)  -  SORT(VRAO(IALPHA)/NUMRAD(IALPUA) ) 

10701  CONTINUE 
ENDIF 
ENDIF 

90909  RETURN 
END 

SUBROUTINE  WFH(U.V.W) 


THIS  SUBROUTINE  CALCULATES  HORIZCWTAL  WINDS  FROM  MAPSTAR  SPPS . 
AUGUST  17,  1990 


CHARACTER* 1  POLAR 
CHARACTER* 40  INFILE. OUTFILE 
CHARACTER* 27  INPATH 
CHARACTER* 19  OUTPATM 
CHARACTER* 10  TUREKTIME 

INTEGER* 4  RE J . IH , POINT , NPOINTS ( 50 ) , HOWLONG . NPV . NPVO . TESTFUG . 
IFI TFLAG . MINH . MINV . NUMRAD , YEAR , MONTH . DAY . HOUR . MINUTE , NOW 
DIMENSION  H( 3. 3) .WIND( 3) .U( 50) .V| 50) .W( 50) 

REAL*4  SIGMA, SIGMALAST, PI 
INTEGER*4  FLAG. IZA 

COMMON  /WINDl/  SPP{ 2300, 7) ,SPPZ{ 15, 2300. 7) 

COMMON  /WIND2/  Z.TRP(50). 

1  REJ(4).LINE{10). 

2  WIDTH(50).IWT(2300).M1SDVR(50), 

4  COSL( 2300 ),COSM( 2300 ).COSN( 2300 ).DVR( 2300), 

5  NUMRAD{17).VRaD(17) 

COMMON  /WIND3/  PI.VMAX.THMAXH.THMINH.THMAXV.THMINV.MINH.MINV. 
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1  NS IGMA . TESTFLAG . IH. NPOINTS . INFILE , OUTFILE , 

2  INPATH . OUTPATH . NPH . HPV . NPVO .SLOPE . INTERCEPT . FI TFUG 
COMMON  /SPPFILE/  IFILE.NFILE. POLAR 

COMMON  /TIMER/  INTNIRI. YEAR. MONTH, DAY. HOUR. MINUTE. TUREKTIME. 
•HOWLONG.NOW 
C 

DO  10101  lA  =  1  1 
WIND(IA)  =  0 
DO  10101  IB  =  1.3 
H(IA.IB)  =  0 

10101  CONTINUE 

DO  10102  11  =  1.17 
NUMRAD(II)  =  0 
VRAD(n)  =  0 

10102  CONTINUE 

NPH  =  NPOINTS (IH) 

DO  10201  POINT  =  l.NPOINTS(IH) 

IWT( POINT)  =  1 

SIN2AX  =  SORT{SIN(SPP{POINT.3)*PI/180)*‘2 
1  ♦  SIN|SPP(P0INT,4)*P1/180)**2) 

IF  ((SINZAX  .LT.  SIN(THMINH*P1/180))  .OR. 

1  (SINZAX  .GT.  SIN(THMAXH‘PI/180)))  THEN 

IWT{ POINT)  =  0 
NPH  =  NPH  -  1 
IF  (NPH  .LT.  MINH)  THEN 
FITFLAG  =  0 
GO  TO  90909 
ENDIF 
ENDIF 

COSL(POINT)  =  SIN(SPP(POINT.3)»PI/180) 

COSM(POINT)  =  SIN(SPP(POINT.4)*PI/180) 

COSN(POINT)  =  SORT(l  -  COSL(POINT) ••2  -  COSM(POINT)*»2) 

10201  CONTINUE 

SIGMAUST  =  1E8 
20001  FLAG  =  0 

DO  10301  POINT  =  l.NPOINTS(IHj 
IF  (IWTIPOINT)  .EO.  0)  GO  TO  10301 
H(l.l)  =  H(l.l)  ♦  COSL{POINT)**2 
H(1.2)  =H(1,2)  ♦  COSL( POINT )*COSM( POINT) 

H{2.2)  =H(2.2)  ♦  COSM(POINT)'*2 

WIND(l)  =WIND(1)  ♦  SPP|POINT,2)*a)SL(POINT) 

1  -  COSL( POINT )»W(IH) 

WIND(2)  =  WIND{2)  ♦  SPPfPOINT, 2) ‘COSMIPOINT) 

1  -  COSM( POINT) •W(IH) 

10301  CONTINUE 

H(2.1)  =  H(1.2) 

DET  =  H|1,1)*H|2,2)  -  H(l,2)*'2 
IF  (ABS(DET)  .LT.  l.OE-7)  THEN 

WRITE  (*,•)  MVH;  NO  SOLUTION' 

FITFLAG  =  0 
GO  TO  90909 
ENDIF 

U(IH)  =  (WIND(1)*H(2,2)  -  WIND{2)*H{1.2) )/DET 
V(IH)  =  (H|1,1)*WIND(2)  -  H|1,2)*WIND(1))/DET 
C  CALCUUTE  THE  STANDARD  DEVIATION  (SI(»1A) 

ERRORSUM  =  0 

DO  10401  POINT  =  l,NPOINTS(IH) 

IF  (IWT( POINT)  .EO.  0)  GO  TO  10401 
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DVR(POINT)  =  SPP(POINT.2)  -  U( IK) 'COSLt POINT) 

00001915 

1  -  V(IH)*COSM{POINTJ  -  W(IH)»COSN( POINT) 

00001916 

ERfiORSUM  =  ERRORSUM  ♦  DVR(P01NT)**2 

00001917 

10401  CONTINUE 

00001918 

SIGMA  =  SORT ( ERRORSUM/ NPH) 

00001919 

DO  10501  POINT  =  l.NPOINTS(IH) 

00001920 

IF  (IWT{POINT)  .EO.  0)  GO  TO  10501 

00001921 

IF  (ABS( DVR (POINT))  .GT.  NS IGMA* SIGMA)  THEN 

00001922 

IWT( POINT)  =  0 

00001923 

• 

FLAG  =  1 

00001924 

NPH  =  NPH  -  1 

00001925 

IF  (NPH  .LT.  MINH)  THEN 

00001926 

FITFLAG  =  0 

00001927 

GO  TO  90909 

00001928 

ENDIF 

00001929 

ENDIF 

00001930 

!  V 

10501  CONTINUE 

00001931 

IF  (FLAG  .EO.  0)  GO  TO  20002 

00001932 

1 

IF  (FLnC  .^0.  1)  THEN 

00001933 

IF  (SIGMA  .GE.  0.999*SIGMALAST)  GO  TO  20002 

00001934 

IF  (SIGMA  .LE.  0.01)  GO  TO  20002 

00001935 

SIGMALAST  =  SIGMA 

00001936 

GO  TO  20001 

00001937 

ENDIF 

00001938 

C  GOOD  VELOCITY. 

00001939 

20002  IF  (  (ABS(U(IH))  .GT.  VMAX)  .OR. 

00001940 

1  {ABS(V(IH))  .GT.  VMAl)  .OR. 

00001941 

2  {ABS{W(IH))  .GT.  VMAX/20)  )  THEN 

00001942 

FITFLAG  =  0 

00001943 

GO  TO  90909 

00001944 

ENDIF 

00001945 

IF  (FITFLAG  .EO.  1)  THEN 

00001946 

RMSDVR(IH)  =  0 

00001947 

DO  10601  POINT  =  l.NPOINTS(IH) 

00001948 

IF  (IWT{ POINT)  .EO.  0)  GO  TO  10601 

00001949 

• 

DVR(POINT)  =  SPP(POINT.2)  -  U(IH) ‘COSLiPOINT) 

00001950 

1  -  V(IH)*COSM( POINT)  -  W|IH)*COSN| POINT) 

00001951 

RMSDVR(IH)  =  RMSDVR(IH)  +  DVR(POINT)»*2 

00001952 

ZA  =  (180/PI)*ASIN{SQRT(1-COSN(POINT)»*2)) 

00001953 

IZA  =  INT(ZA)  ♦  1 

00001954 

IF  (IZA  .GT.  17)  THEN 

00001955 

WRITE  (*.•)  IZA  =  ■ ,IZA 

00001956 

• 

FITFLAG  =  0 

00001957 

GO  TO  90909 

00001958 

ENDIF 

00001959 

IF  (IZA  .EO.  17)  IZA  =  16 

00001960 

VRAD(IZA)  =  VRADIIZA)  ♦  DVR(POINT) **2 

00001961 

NUMRAO(IZA)  =  NUMRAD(IZA)  >  1 

00001962 

• 

10601  CONTINUE 

00001963 

IF  (NPH  .GT.  0)  THEN 

00001964 

RMSDVR(IH)  =  SORT(RMSDVR(IH)/NPH) 

00001965 

DO  10701  lALPHA  =1,16 

00001966 

IF  (NUMRAD(IALPHA)  .EO.  0)  GO  TO  10701 

00001967 

C  WRITE  (•,•)  ■ZA.VRAD.HUMRAD=  ' , lALPHA. VRAD| lALPHA) .NUMRAD{ lALPHA) 

00001968 

VRAD(IALPHA)  =  SORT (VRAD( I ALPHA )/NUMRAD{ I ALPHA ) ) 

00001969 

• 

10701  CONTINUE 

00001970 

ENDIF 

00001971 

ENDIF 

00001972 
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90909  RETURN 
END 

SUBROUTINE  PHFIT 


C 

C  THIS  SUBROUTINE  FITS  A  STRAIGHT  LINE  TO  THE  VARIATION  OF  VELOCITY 
C  VARIANCE  VS  ZENITH  ANGLE. 

C  JULY  23.  1990 

C 


CHARACTER* 1  POLAR 

CHARACTER*40  INFILE. OUTFILE 

CHARACTER* 27  INPATH 

CHARACTER*19  OUTPATH 

CHARACTER* 10  TUREKTIME 

INTEGER* 4  YEAR . MONTH . DAY . HOUR . MINUTE . 

1  RE J . IH . NPOINTS | 50 ) . HOWLONG , NPV . NPVO , TESTFLAG , FI TFLAG , 

2  MINH.MINV.NUMRAD.NOW 
REAL* 4  INTERCEPT 

COMMON  /WINUl/  SPP(2300. 7) .SPPZ(15.2300. 7) 

COMMON  /WIND2/  2.TRP(50). 

1  REJ(4),LINE(10), 

2  WIDTH(50),IWT(2300),RMSDVR(50J. 

4  COSL|2300),COSM|2300).COSN{2300),DVR(2300). 

5  NUMRAD|17).VRAD(1?) 

COMMON  /WIND3/  PI.VMAX.THMAXH.THMINH.THMAIV.THMINV.MINH.MINV, 

1  NSIGMA, TESTFLAG. IH, NPOINTS, INFILE, OUTFILE, 

2  INPATH, OUTPATH. NPH, NPV. NPVO. SLOPE. INTERCEPT. FITFUG 
COMMON  /SPPFILE/  IFILE.NFILE, POLAR 

COMMON  /TIMER/  INTNUM. YEAR. MONTH. DAY. HOUR. MINUTE. TUREKTIME, 
•HOVfLONG.NOW 
C 

SUMVR  =  0 
SUMVRPH  =  0 
SUMPH  =  0 
SUMPH2  =  0 
SUMI  =  0 

DO  10101  lALPHA  =  1,17 

IF  (HUMRAD(IALPHA1  .EO.  0)  GO  TO  lOIOI 

2A  =  lALPHA  -  0.5 

SUMVR  =  SUMVR  VRAO( lALPHA) 

SUMVRPH  =  SUMVRPH  ♦  VRAD| lALPHA )*ZA 
SUMPH  =  SUMPH  ♦  ZA 
SUMPH2  =  SUMPH2  ♦  ZA**2 
SUMI  =  SUMI  ♦  1 
10101  CONTINUE 

IF  (SUMI  .GT.  0)  THEN 

IF  |SIMI*SUMPH2  -  SUMPH**2  .GT.  0)  THEN 

SLOPE  =  (SUMI'SUMVRPH  -  SUMVR'SlfllPH)/ {SUMI*SUMPH2  -  SIMPH**2) 

INTERCEPT  =  {SUMVR  -  SLOPE 'SUMPH) /SUMI 

ELSE 

SLOPE  =  0 

INTERCEPT  =  0 

ENDIF 

ENDIF 

RETURN 

END 

SUBROUTINE  REORDER  (U.V.W) 


00001973 

00001974 

00001975 

00001976 

00001977 

00001978 

00001979 

00001980 

00001981 

00001982 

00001983 

00001984 

00001985 

00001986 

00001987 

00001988 

00001989 

00001990 

00001991 

00001992 

00001993 

00001994 

00001995 

00001996 

00001997 

00001998 

00001999 

00002000 

00002001 

00002002 

00002003 

00002004 

00002005 

00002006 

00002007 

00002008 

00002009 

00002010 

00002011 

00002012 

00002013 

00002014 

00002015 

00002016 

00002017 

00002018 

00002019 

00002020 

00002021 

00002022 

00002023 

00002024 

00002025 

00002026 

00002027 

00002028 

00002029 

00002030 


« 


« 


i 
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c 

C  REORDERS  IDI  WIND  OUTPUT  FILES  IN  DESCENDING  HEIGHT. 

C  THIS  PORTION  OF  THE  PROGRAM  IS  SPECIFIC  TO  A  43KM  HEIGHT  RANGE 

C 

CHARACTER*  1  TAB.  POUR 
CHARACTER'10  TUREKTIME 
CHARACTER*40  INFILE. OUTFILE 

DIMENSION  H(50) .U(50).V{50).W(501.UI(50) .VI(50) .WI(50|.TRP(50) . 
•XH(50) .RT(50) .SL(50).ICPT(50) 

INTEGER*4  IFILE. YEAR. MONTH. DAY. HOUR. MINUTE. NPOINTS( 50) .HOWLONG 
COMMON  /WIND3/  PI .VMAX.THMAIH.THMINH.THMAIV.THMINV.MINH.MINV. 

1  NS  IGMA .  TESTFUG .  IH .  NPOINTS  .INFILE.  OUTFI LE 

COMMON  /SPPFILE/  IFILE. NFILE. POLAR 

COMMON  /TIMER/  INTNUM. YEAR. MONTH. DAY. HOUR. MINUTE. TUREKTIME. 
•HOWLONG, NOW 

COMMON  /ARRAYS/  A(43.33) 

C 

TAB=CHAR(9) 

WRITE  (*,•)  '•  REORDERING  FILES  BY  DESCENDING  HEIGHTS" 

CLOSE  (16) 

NERR=8 

OPEN  ( 16. ERR=90950. FILE=OUTFILE. STATUS="OLD" . FORM=" FORMATTED" ) 
IH=1 

90912  READ  { 16. 90001. END=90920. )  H(IH) .UI(IH) .VI(IH) .WI(IH) .TRP(IH) . 
•XH{IH) .RT(IH).SL{1H1 .ICPT(IH) 

90001  FORMAT  {9(E13.4)) 

IH=IH+1 

GO  TO  90912 

90920  REWIND  (16) 

L«0 

J=15 

90921  I=J 
K=0 

90922  WRITE  (16.90002)  H( I ) .TAB.UI ( I ) .TAB. VI( I ) .TAB. WI ( I ) . TAB. TRP( I ) . 
•TAB. XH{ I ) . TAB. RT{ I ) . TAB. SL( I ) . TAB. ICPT| I ) 

90002  FORMAT  (E13.4. 8(A1.E13.4) ) 

L=L+1 

U(L)=UI(I) 

V(L)=VI(I) 

W(L)=WI(I) 

IF  (I.EO.l)  GO  TO  90940 
K=K+1 

IF  (K.EO.l)  THEN 
1=1+28 
GO  TO  90922 
END  IF 

IF  (K.E0.2)  THEN 

1=1-14 

GO  TO  90922 

ELSE 

J=J-1 

GO  TO  90921 
END  IF 

90940  CLOSE  (16) 

RETURN 

90950  WRITE  {•.')  "  ERROR  IN  REORDERING  FILES.  NERR  =  ".NEHR 
PAUSE  "  CR  TO  EXIT" 

STOP 


00002031 

00002032 

00002033 

00002034 

00002035 

00002036 

00002037 

00002038 

00002039 

00002040 

00002041 

00002042 

00002043 

00002044 

00002045 

00002046 

00002047 

00002048 

00002049 

00002050 

00002051 

00002052 

00002053 

00002054 

00002055 

00002056 

00002057 

00002058 

00002059 

00002060 

00002061 

00002062 

00002063 

00002064 

00002065 

00002066 

00002067 

00002068 

00002069 

00002070 

00002071 

00002072 

00002073 

00002074 

00002075 

00002076 

00002077 

00002078 

00002079 

00002080 

00002081 

00002082 

00002083 

00002084 

00002085 

00002086 

00002087 

00002088 


• 

END 

00002009 

SUBROUTINE  DEVIANT 

0C00'>090 

CHARACTER* 1  C4H( 4 ) . BLAHK.MEG 

00002091 

CHAfiACTEH*4  CH4.BLANX4.B(43. 33) 

00002092 

• 

REAL  NINES 

00002093 

c 

COMMON  /ARRAYS/  A|43.33).B 

00002094 

00002095 

EOUIVALENCE  (CH4.C4H) 

00002096 

c 

00002097 

c 

CALCULATE  IDI  AND  ISR  COMPONENT 

DIFFERENCES.  AND  SET  UP  OUTPUT 

00002098 

c 

ARRAY  FOR  PRINTING  AS  HXCRKOUT 

00002099 

• 

c 

BLANX=CHAR( 32} 

00002100 

00002101 

BLANK4=" 

00002102 

NINES=999 . 0 

00002103 

NEG=--'’ 

00002104 

DO  40  1=1.43 

00002105 

IF  (A(I, 8) .EO.NINES)  GO  TO  40 

00002106 

• 

IF  (A(I. 10) .EO.NINES)  GO  TO  40 

00002107 

IF  |A( I. 14). EO.NINES)  GO  TO  40 

00002108 

IF  (A(I. 16) .EO.NINES)  GO  TO  40 

00002109 

A(I.18)=ABS(A(I.8)-A(1.14)) 

00002110 

A(I,19)=ABS|A(I,10)-A{I,16)) 

00002111 

40 

CONTINUE 

00002112 

• 

c 

00002113 

c 

SET  UP  CHARACTER  ARRAY  B(43.33) 

FOR  PRINTING 

00002114 

c 

DO  45  1=1,43 

00002115 

00002116 

DO  45  J=l,33 

00002117 

IF  (A(I.J). EO.NINES)  THEN 

00002118 

CU4=BLANK 

00002119 

• 

GO  TO  44 

00002120 

END  IF 

00002121 

SIGN=A(I.J)/ABS(A(I.J)) 

00002122 

IA=ABS(A(I,J) ) 

00002123 

IF  (lA.EO.O)  A{I.J)=A(I.J)*1.0 

00002124 

IA100=IA/ 100 

00002125 

% 

IA10=IA/10-10*IA100 

00002126 

IA1=IA-100*IA100-10*IA10 

00002127 

C4H(l}=fiLANK 

00002128 

C4H{2}=CUAR(IA100t48} 

00002129 

IF  (lAlOO.EO.O)  C4H(2)=BLANK 

00002130 

C4H{3)=CHAR(IA10*48) 

00002131 

C4U(4)=CHAR(IA1«48) 

00002132 

IF  (J.EO.l)  GO  TO  42 

00002133 

IF  {C4H(2).NE. BLANK)  GO  TO  42 

00002134 

IF  (lAlO.EO.O)  C4H(3)=BLANK 

00002135 

42 

IF  (SIGN. GT. 0.0)  GO  TO  44 

00002136 

DO  43  K=3,l,-1 

00002137 

IF  {C4H(K).NE. BLANK)  GO  TO  43 

00002138 

i 

C4U{K)=N£G 

00002139 

GO  TO  44 

00002140 

43 

CONTINUE 

00002141 

44 

B(I. J)=CH4 

00002142 

45 

CONTINUE 

00002143 

RETURN 

00002144 

END 

00002145 

i 
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The  FPS  and  IDI  wind  comparison  program  FPSREDUCT 

This  program  prepares  a  tab  spaced  column  cucpuc  file  :f 
conal  and  meridional  greenline  profile  smccthed  a,'  hourly 
mean  GROVES  v/inds  and  b)  IDI  winds  !  creased  by  IDIV.'IND.ri, 
and  Fabry-Perot  spectrometer  winds,  suitable  for  reading  into 
a  plotting  program. 


INPUT 


Reads  either  XXXXXXTIDE  or  XXXXXXGROOUT  file  cusput  frc.m 
GROVES,  and  smooths  with  a  greenline  profile  to  produce 
zonal,  meridional  and  vertical  winds  at  hourly  intervals  from 
1900  LMST  to  0500  LMST  for  the  night  of  interest  .  .Accesses 
the  "TIDE"  file  if  GROVES  output  consists  oniy  of  .mea.n 
(prevailing  wind),  diurnal  and  sem.idiurnal  components  only, 
via  SUBROUTINE  GLINE2,  or  accesses  the  "GROOUT"  file  (read  by 
SUBROUTINE  GLINE!)  if  more  than  two  harmonic  periods  have 
been  generated  by  GROVES.  Selection  is  made  by  entering  "T" 
(for  "TIDE")  or  "G"  (for  "GROOUT")  at  the  prompt  request. 

Enter  FPS  input  (on  disc)  and  output  (your  choice) 
filenames  when  prompted. 

Enter  IDI  input  file  XXXXXXXX.MAW  height  spacing  (all 
.MAW  files  generated  after  March  1,  1993,  have  l]<m  height 
spacing.  Most  of  those  generated  before  this  date  are  spaced 
3km).  All  files  created  by  IDIWIND.f  are  1km  spacing. 

Reads  file  SET. TIME,  which  is  simply  a  listing  of  all  the 
interval  center  point  times  of  the  .MAW  files  to  be  accessed, 
formatted  as  follows 

8905031215 

8905031322 


0000000000  !  EOF  FLAG 

Program  then  uses  SUBROUTINE  INNAME  to  create  the 
appropriate  IDI  input  filename. 


After  accessing  the  selected  .MAW  rile,  SUBROUTINE 
GREENIDI  is  then  called,  and  the  IDI  profiles  are  greenline 
smoothed,  and  the  ASCII  output  file  written. 
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o  o  o  n  o  o  o 


P.EADS  r-ITHtR 


[ 


I 


c 


,'';-{zp ^  Z'Syi  t  5  ;•  ,  rAB,WHI''H 
CHARACTER  3  ELAfIKE 
CHARACTER  *  5  D'CM>rCl ,  DUMM'/C 

CHARACTEP,*40  FILEIJJ,  FILEGUT,  C-RCCL'T,  TICE,  MA'.vE ICE 
DIMEMSICN  TIME('2>  .'J'S.V;  ,EERREV;(72i  ,-.T;E(''2  .EERrCC--" 
IMTEGER*4  YEA.R,  DAY,  HOUR,  MINUTE 
REAL *4  NINES 

COMMON  /IDI  '  PULSE.VEWIDI  (-2)  .  EP.f.EV,  "  2  ■  ,  ■."ilSlZZ  '  ~  2  ■■  ,  ERRNS 
*’A/JIDI  (72  )  ,  ERRW(72  > 

COMMON  ,'IDIG,  GTIMEI24)  ,GHEW(24)  ,3RN3'24)  ,  C-R'.-.'l24) 
EQUIVALENCE  ( GROOUT , DUMRT/l ) 

EQUIVALENCE  ( TIDE ,  OLT-IMYE  ) 

EQUIVALENCE  ( MAWFILE , DUM > 

COMMON  /IDIFILES/  M.AWFILE ,  MONTH  ,  DAY,  HOUR ,  MINUTE 
TAB=CKAR ( 9 ) 

NINES=999 . 0 
DO  20  N=l,24 
GTIME(N) =NINES 
VEWIDI (N) =NINES 

20  CONTINUE 

DO  21  N=l,72 
TIME(N) =NrNES 
VEW(N)  =:NINES 
VNS(N) =NINES 

21  CONTINUE 
BLANKS =“ 

■  E  (*,*)  '■  PROGRAM  FPSREDUCT” 

.  k-TE  (*, *)  “  " 


GET  GROVES  DATA  (XXXXGROOUT  OR  XXXXXXTIDE  FILE) 


WRITE  (*,*)  ”  ENTER  T  FOR  TIDE,  G  FOR  GROOUT  INPUT" 

READ  ( * , * )  WHICH 
TIDE="  TIDE" 

GROOUT ="  GROOUT" 

WRITE  (»,♦)  "  ENTER  TIDE/GROOUT  FILENUMBER" 

READ  (  •  ,  *  )  DUMMYl 


IF  (WHICH, EQ, "G" )  THEN 

OPEN  ( 17 , FILE=GROOUT, ACTION="READ" , FORM= " FORMATTED " ) 

CALL  GLINEl 

ELSE 

DUMMY2=DUMMY1 

OPEN  (17,FILE=TIDE,ACTION=“READ" , FORM= " UNFORMATTED " ) 
CALL  GLINE2 
END  IF 
CLOSE  (17) 


GET  FPI  DATA  (FPIYYYYYY  FILE) 

WRITE  (*,*)  "  ENTER  FPI  INPUT,  OUTPUT  FILENAMES" 

READ  (*,*)  FILEIN, FILEOUT 

OPEN  (17 , FILE=FILEIN, ACTION="READ“ , FOPJ4= " FORMATTED " ) 
OPEN  (16, FILE=FILECUT, FOPM= " FORMATTED" ) 


.1 V  w  c  0  2  , 


C  C  0  0  002  4 
OC00002S 
0  0  0  0  C  0  2  e 
:000C02" 
OOCOC028 
3  0  C  0  c  0  2  9 
20000020 
OOOOCC2  1 
OC0CCO32 
00C00O33 
00000034 
00000035 
0CC00036 
00000037 
0000003S 
0000003? 
00000040 
00000041 
00000042 
00000043 
00000044 
00000045 
00000046 
00000047 
00000048 
00000049 
00000050 
00000051 
00000052 
00000053 
00000054 
00000055 
00000056 
00000057 
GO0Q0058 
C0000Q59 
00000060 
00000061 
00C00062 
0  0  C  0  C  0  6  3 
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non  o  o  o 


GET  id:  winds  (MOJOHPJ4IN.MA'.v  FILES) 


12 

101 


13 


I  "  ENTER  IDI  he: 
LFlILSE 


5HT 


Jpy.=  ■  FCFr_'.TTED ' 


JTE 


WRITE  ( ’ 

READ  ( * , 

PULSE=0.2 

IF  (LPUL3E. EQ. 3 )  PULSE=0.08 
WRITE  (  *  ,  * )  "  PULSE  =  “  , PULSE 

OPEN  (27, FrLE="SET.TIME" , ACTION=“RES 
1  =  1 

READ  (27 , 101 , END=13 )  YEAR, MONTH, DAY, KCUR, MI' 

FORMAT  (512) 

IF  (YEAR.EQ.O)  GO  TO  13 
TIME(I) =FLOAT{HOUR) +FLOAT (MINUTE )  .  60 . 0 
IF  (TIME(  I)  .LT.  12 . 0)  TIME  ( I )  =TIME  ( I )  <-24 . 0 
CALL  INNAME 

WRITE  (*,♦)  '■  PROCESSING  FILE  ■,MAWFILE 

OPEN  ( 17 , FILE=MAWFILE, STATUS=*OLD" , ACTION^ ■ READ ” , FORM= 

CALL  GREENIDI  (I) 

CLOSE  (1/) 

GET  NEXT  IDI  FILE 

1  =  1  +  1 
GO  TO  12 

PREPARE  OUTPUT  FILE 

CLOSE  (17) 

CLOSE  (27) 

J  =  1 


0  0  0  C  0  G  S  8 
00:.'OC8  9 
00000090 
00C00091 
•  FOPJ>ii.TTED  ”  )  0  0  0  C  Q  0 9  2 
00000093 
00000094 
G0000095 
00000096 
00000097 
00000098 
00000099 
00000100 
00000101 
00000102 
00000103 
00000104 
00000105 


K=1 

14  WRITE  (*,*)  GTIME(J) ,TIME(K) 

IF  (GTIME(J) .EQ. NINES. AND. TIME (K) .EQ. NINES)  GO  TO  15 

IF  (GTIME(J) .LT.TIME(K) )  THEN 

WRITE  (16,102)  GTIME(J) ,TAB,GREW(J) ,TAB,GRNS(J) ,TAB,GRW(J) 

102  FORMAT  ( F8 . 3 , 3 ( A1 , F8 . 0 ) ) 

J=J  +  1 

GO  TO  14 

ELSE 

IF  (VEWIDKK)  .LT.900.0.AND.'/NSIDI(K)  .LT.  900.0 
♦. AND. VEW(K) .LT. 900.0. AND. VNS(K) .LT. 900.0)  WRITE  (16,103) 

‘TIME ( K ) , TAB , BLANKS , TAB , BLANKS , TAB , BLANKS , TAB , VEWI DI ( K ) , TAB , 
*ERREW(K)  ,TAB,  VNSIDI  (K)  ,  TAB ,  ERRNS  ( K )  ,  T.AB ,  VWIDI  ( K )  ,  T.AB  ,  ERRW  (  K  )  , 
‘TAB , VEW ( K ) , TAB , FERREW ( K ) ,  TAB , VNS ( K ) , TAB , FERPJ4S ( K ) 

103  FORMAT  (F8.3, 3 (A1,AS) , 10(A1,F8.0) ) 

IF  (VEWIDI (K) . GT. 900.0. OR. VNSIDI (K) .GT. 900.0 
‘. AND. VEW(K) .LT. 900.0. AND. VNS(K) .LT. 900.0)  WRITE  a6,lG4; 

‘TIME ( K) , TAB, BLANKS , TAB, BLANKS , TAB , BLANKS , TAB , BLANKS , TAB , BLANKS , 
‘TAB ,  BLANKS  ,  TAB ,  BLANKS  ,  TAB ,  BLANKS  ,  TAB ,  BLANKS  .  TAB ,  VEW  '  K )  ,  T.^E  , 
‘FERREW (K) , TAB, VNS (K) , TAB , FERRNS ( K ) 

104  FOPJ4AT  (F8 . 3 , 9 (Al, AS) , 4 (A1 ,F8.0) ) 

IF  (VEWIDKK)  .LT.900.0.AND.'7NSIDI(K)  .LT.  900.0 


00000106 

00000107 

00000108 

00000109 

OOOOQllO 

00000111 

00000112 

00000113 

00000114 

00000115 

00000116 

00000117 

00000118 

00000119 

00000120 

00000121 

00000122 

00000123 

00000124 

G0C00125 

00000126 

0000C127 
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oo  ooo  non  ooo 


•  ^  E!  F  ?  V 


14 


3  TCP 
EUD 

SUBROUTINE  S-LINEl 

MAP.C 

READS  GRCS’ES  WIND  FROM  FILE  “ XMXXXXGROOL'T 


CHARACTER  *  8  D  IRI'W ,  WHAT’W 

CHARACT£R*9  DIRNEW, WHATEW 
CHARACTER  *  1 1  D I RNNS , KHATNS 
DIMENSION  VXi24)  ,VY(24)  ,VZ(24)  ,'WTilC) 

COMMON  /IDIG/  GTIME  i 24 ) , GREW ( 24  I , GENS ( 24 i , GRW ( 24 i 
DATA  WT .0.04867,0.07028,0. 093  52 ,0.1147,0.129^,  ''  .  1350  , 
*0.1296,0.1147,0.09352,0.07028/ 

DO  10  1=1,11 

GREW(I)=0.0 

GRNS ( I ) =0 . 0 

GTIME(  I)  =18 . 0*FLO,AT(  I) 

10  CONTINUE 

DIRNEW=  ■'  EAST-WEST " 

DIRNNS= "NORTH-SOUTH" 

DIRNW= "VERTICAL" 

SKIP  DOWN  TO  EAST-WEST  102KM 

1  READ  ( 17  ,  *  )  WH.ATEW 

IF  ( WHATEW. NE. DIRNEW)  GO  TO  1 

DO  2  1=1 , 16 

READ  (17,*)  WHATEW 

2  CONTINUE 

DETERMINE  GREEN  LINE  SMOOTHED  VELOCITY 
DO  3  K=l, 10 

READ  (17,100)  IH, (VX(J) , J=l, 11) 

WRITE  (*,100)  IH, (VX(J) , J=l, 11) 

100  FORMAT  (15, 38X, 11F5.0) 

DO  3  1=1, 11 

GREW(I) =GREW(I) +VX ( I ) *WT{K) 

3  CONTINUE 

SKIP  DOWN  TO  NORTH  -  SOUTH  102 KM 

4  READ  (17,*)  WHATNS 

IF  ( WHATNS. NE.DIRNNS)  GO  TO  4 

DO  5  1=1,16 

READ  (17,*)  WHATNS 

5  CONTINUE 

DETERMINE  GREEN  LINE  SMOOTHED  VELOCITY 
DO  6  K=l, 10 

READ  (17,100)  IH, (VY(J) , J=l, 11) 

WRITE  (*,100)  IH,  (’'/Y(J)  ,  J=l,  11) 


4  9 


’■3030151 


'j  ■-  0  0  015  3 


3  0  3  C  0 1 5  5 
30000156 
000G0157 
00000158 

n  n  n  .n  -  ■> 

CQ00C160 

00000161 

0000C162 

C0''700163 

00000164 

00000165 

00CG0166 

00000167 

00000168 

00000169 

00000170 

00000171 

00000172 

000001^3 

00000174 

00000175 

00000176 

000001'’7 
OOGOCl/’B 
000001^9 
■00000180 
00000191 
00000182 
00000183 
00000184 
00000135 
000C0186 
00000187 
00000133 
00000139 
0  0  0  0  0 1 9  O' 
00000191 


I 
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on  o  o  o 


;Rr;3 


^EAD  (I”,*'  v;hatw 
;ONTrNUE 


DETEF^lINE  OREEIJ  LINE 


.  rtz._ 


DO  9  K=l,10 

READ  (17,100)  IH,  IVE  ; J)  , J  =  1 , 11 ! 

WRITE  (*,100)  IH, (VZ ( J) , J=1 , 11 > 

DO  9  1=1,11 

GRW ( I )  =  ( GRW ( I ) ^VZ ( I ) *WT i K  M 
9  CONTINUE 

RETURN 

END 

SUBROUTINE  GLINE2 

C  MARCH  6,  1993 

C  CALCULATES  TIDAL  WIND  FROM  TIDAL  COEFFICIENTS, 

C  READING  FILE  "XXXXXXTIDE- 

DIMENSION  AU(4)  ,  PH(4  )  ,  VXdO,  24)  ,  VY(  10, 24  I  ,  VZ(  10, 24  i  ,  WT'  10  I 
COMMON  /IDIG/  GTIME  ( 24 ) , GREW ( 24 ) , GPJ4S ( 24 ) , GRW ( 24  I 
DATA  WT/ 0.04867, 0.07 028, 0.023 52, 0.1 147.0.1296, 0.1 ISO, 
*0.1296,0.1147,0.09352,0.07028/ 

TWOPI=6 . 28318 

DO  10  1=1, 11 

GREW(I) =0.0 

GRNS(I)=0.0 

GTIME (I) =18.0+FLOAT(I) 

10  CONTINUE 

SKIP  DOWN  TO  EAST-WEST  lOPKil 
DO  1  1=1,14 

READ  (17)  UO, (AU( J) , PH(J) , J=l, 2) 

1  CONTINUE 

DETERMINE  GREEN  LINE  SMOOTHED  VELOCITY 

C 

DO  2  1=1,10 

READ  (17)  UO, (AU(J) , PH(J) ,J=1,2) 

DO  2  IT=1, 11 
T=GTIME(IT) 

IF  (PH(l).LT.T)  PHASE1=PH(1) -T 
IF  (PH(l).GE.T)  PHASE1=T-PH(1) 

IF  (PH(2).LT.T)  PHASE2=PH(2) -T 
IF  (PH(2).GE.T)  PHASE2=T-PH(2) 

VX( I, IT) =UO+AU(l) *COS( (PHASEl/24. 0) *TWOPI) 

*+AU(2) *COS ( (PHASE2/12 .0) *TWOPI) 

2  CONTINUE 
DO  3  J=l,ll 
DO  3  1=1,10 

GREW( J) =GREW( J) +VX( I, J) *WT ( I ) 

3  CONTINUE 
C 

C  SKIP  DOWN  TO  NORTH  -  SOUTH  102KM 


J  C  0  0  C  2 1 S 
:  0000219 
OOOCC22C 
■:000C221 
00000222 
0  0  ‘0  0  0  2  2  3 

0  0  C  7  '0  2  2  5 

p  p,  Q  n  P  p 
0000022" 
00000228 
00000229 
00000230 
00000231 
00000232 
OOOOC233 
000CC234 
00000235 
00C00236 
00000237 
0000C238 
00000239 
00000240 
0OOCO241 
000C0242 
00000243 
00000244 
00000245 
00000246 
00000247 
00000248 
00000249 
00000250 
00000251 
00000252 
00000203 
00000254 
30 000255 
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5  CONTIMUE 

rc  6  j=: , 1 1 
:o  6  1=1,10 

'.jRMS  (  J  )  =GR1IS  ( J  1  (  I ,  J  j  * >,T  ‘  1  ) 

6  CONTINUE 

SKIP  DCWJ  TO  VERTIC.-^l  i:2:<M 
00  7  1=1,42 

READ  (17)  UO, 'AU( J) , FK( J) , J=1 . 2 ) 
^  CONTINUE 


C 


DETERMINE  GREEN  LINE  SMOOTHED  VELOCITY 


DO  8  1=1,10 

READ  (17)  UO,  (.AU(,J)  ,  PHiJt  ,J  =  1,2) 

DO  8  IT=1, 11 
T=GTIME(IT) 

IF  (PH(l).LT.T)  FHASEi  =  ?Ha) -T 
IF  (PH{1).GE.T'  PHASE1=T-FH(1) 

IF  (PH(2).LT.T)  PHASE2=?H(2) -T 
IF  (PH(2).GE.T)  FHA3E2=T-PH(2) 

VZ  ( I ,  IT)  =UO+AU  (  1 )  *COS  (  (PHASE1,''24 .0)  *TWOFI) 
*+AU(2 ) *COS ( ( FHASE2/12 .0) *TWOPI ) 

8  CONTINUE 

DO  9  J=l, 11 
DO  9  1=1,10 

GRW ( J ) = ( GRW ( J ) +VZ ( I , J ) *WT ( I ) ) 

9  CONTINUE 
RETURN 
END 

SUBROUTINE  INNAME 
C 

C  Iin^AME  CREATES  MCJOHRMIN . MAW  INPUT  FILENAMES. 

C 

CHARACTER* 2  ASCMONTH , ASCDAY , ASCHOUR , ASCMINUTE 

CHARACTER*40  MAWFILE 

CHARACTER*19  INPATH 

INTEGER*4  MONTH , DAY , HOUR , MINUTE 

COMMON  /IDIFILES/  MAWFILE , MONTH , DAY , HOUR , MINUTE 

C 

INPATH="MAXTOR600:OUTFILES: " 

IF  (MONTH  .LT.  10)  THEN 
WRITE  (ASCMONTH, 9C001 )  'O', MONTH 

90001  FORMAT  (A1,I1) 


C  0  0  0  O'  2  i  9 
00000290 
00000291 
0  0  0  0  C  2  9  2 
00000293 
00000294 
0  0  C'  0  0  2  9  5 
0  0  0  J  02  9  8 
CCCC0297 
00000296 
0  0  0  0  C  2  9  9 
0000C330 
00000301 
00000302 
0  0  0  0'  'v  0  3 
00000304 
CC0003C5 

C0C0O3C7 
00000308 
00000309 
000C0310 
00000311 
00000312 
J  000  0  31 3 
0C000314 
0000031^ 
00000316 
00000317 
0  0  0  0  0  318 
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WFZTS 

Z  IMPAT.l ,  ASCMCMTH  ,  ASCr.AV .  A.E:.H.'.-"?- ,  .AEEMI!:VTE  ,  '  .  MAW  ‘ 

^  L'  ^  FOR.MAT  (  A1  5  ,  4  A2  ,  A4  ) 

RE : CRN 
END 

SUBROUTINE  GF.EENIDI  (I) 

DIMENSION  •/XilOt  , '-A' (  1  J )  ,VZtlOl  .  WT  (  1 0  ' 

F.EAL*4  NINES 

COMMON  '  IDI  '  PULSE, 7EWIDI  |T2  i  ,  ERREWt  'll  ,'.TISIDI  ("2  ;  ,  ERRNS  ■  “2  i  , 
*\'’WIDI  (72)  ,  ERRW(72) 

DATA  WT/0.04867, 0 . 0702?,  0 . 0?  3  52  ,  C  .  1 14  ,  0  .  ICOt: ,  2  .  1 3  50 , 
*0.1296,0.1147,0.09352,0.07023- 
NINES=993 . 0 
V.XSUJ-}=0 .  0 
VY3UM=0 . 0 
VZSrjM=0.0 
WTSUM=0 . 0 
OME=l  .  0 

3  READ  !  17  ,  "  (4213 . 4  )  "  ,  END  =  4  ,  Z ,  VX  ( J)  .  VY  '  J  ,  ,  VD  i ' 

:diz=z 

IF  ( IDIZ.GT , 102 )  GO  TO  3 
IF  ' IDIZ.LT. 93)  30  TO  4 
I F  ( VX IJ)  . GT . 9  0  0 . 0 )  THEM 
J  =  J^-1 
GO  TO  3 
ELSE 

VX.SUt;=VX3UM+  Va  ( J  )  *WT  ( J  ) 

'ASUM=VVSU>1*VY  ( J )  *  WT  ( J  ) 

VZSITM  =  VZSUM-VZ  ( J)  *WT  ( J) 

■WTSUM=WT3LfM -WT  ( J ) 

.1=2-1 
■GO  TO  3 
xMl.  x- 

4  IF  (WTSUM.E2.0.0)  THEN 
VEW'IDI  i  I  I  =NINES 
RETURN 

ELSE 

VEWIDI  (  :  >  =7XCUT4*ONE,-WTSUM 
■TISIC:  ?  I  )  =ri'SUM*CNE,  WTSUM 
TWIDI  !  I  I  =7Z3UM*  ICO  .  0  V.'TSUM 
E  R  WT  =  ?  U  L  3  E  '  VJT  S  (JM 

EF.REWI  I  !  -5  .  C-AB3  (YEWIDI  I  I  i  i  'ERRVjT 

ERRNS  ( I  i  =  R .  :  -a5S;7t;s:d:  ; : . ;  *e??wt 
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4 


Appendix  I 


A  listing  of  file  TUREKFILE  (accessed  by  ISRIDIIDIG.f)  which  gives  the 
interval  number,  date,  start  time,  end  time  and  viewing  azimuth  of  the 
Arecibo  Observatory  incoherent  scatter  radar  for  the  three  AIDA'89 
campaigns.  Because  of  problems  with  phase  jitter  in  the  MAPSTAR 
processor  controller  during  the  March  Scene  I  campaign,  only  the  Scene  II 
and  Scene  III  data  have  been  tabulated. 
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t 


1 

390329 

60850 

63653 

393 

890329 

64102 

70905 

393 

.  j 

890329 

71638 

72834 

303 

4 

890329 

73534 

74619 

213 

5 

890329 

75318 

81825 

6 

890329 

32523 

83610 

213 

r 

390329 

34307 

85352 

303 

390329 

90052 

92559 

393 

9 

890329 

92934 

95440 

393 

10 

890329 

95729 

102235 

393 

11 

890329 

102610 

105117 

393 

12 

890329 

105816 

110901 

303 

13 

890329 

111600 

112646 

213 

14 

890329 

113345 

115851 

123 

15 

890329 

120550 

121635 

213 

16 

890329 

122333 

123419 

303 

17 

890329 

124116 

130622 

393 

18 

890329 

130959 

133506 

393 

19 

890329 

133754 

140300 

393 

20 

890329 

141730 

150344 

393 

21 

890329 

151042 

151316 

303 

890329 

163938 

170923 

123 

23 

890329 

171619 

172703 

213 

24 

890329 

173401 

174444 

303 

25 

890329 

175142 

181641 

393 

26 

890329 

182013 

184513 

393 

27 

890329 

184759 

191306 

393 

28 

890330 

65640 

72139 

393 

29 

890330 

72514 

73557 

393 

30 

890330 

74253 

75336 

303 

31 

890330 

80034 

81117 

213 

32 

890330 

81814 

84313 

123 

33 

890330 

85010 

90053 

213 

34 

890330 

90750 

91833 

303 

35 

890330 

92532 

95039 

393 

36 

890330 

95415 

101921 

393 

37 

890330 

102210 

104717 

393 

38 

890330 

105053 

111560 

393 

39 

890330 

112258 

113345 

303 

40 

890330 

114042 

115129 

213 

41 

890330 

115827 

122334 

123 

42 

890330 

123033 

124118 

213 

43 

890330 

124816 

125902 

303 

44 

890330 

130602 

133109 

393 

45 

890330 

133444 

140320 

393 

46 

890330 

140609 

143116 

393 

47 

890330 

143451 

145959 

393 

48 

890330 

151243 

152329 

303 

49 

890330 

153039 

154124 

213 

50 

890330 

154824 

161331 

123 

51 

890330 

162029 

163115 

213 

52 

890330 

163812 

164858 

303 

53 

890330 

165556 

172103 

393 

54 

890330 

172438 

174947 

393 
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55 

390330 

175235 

181742 

393 

56 

890330 

182117 

184624 

393 

C"? 

1 

890331 

62312 

64541 

393 

56 

890331 

64844 

71114 

393 

59 

390331 

71811 

72768 

303 

60 

04ri'v-;l 

7::451 

74434 

213 

61 

6903  Jl 

75131 

81400 

123 

62 

fc'90  3  31 

82056 

83040 

213 

62 

390331 

83736 

84720 

303 

64 

890331 

85419 

91648 

393 

65 

890331 

91951 

94219 

393 

66 

890331 

94505 

100738 

393 

67 

390331 

101041 

103310 

393 

68 

890331 

104007 

104950 

303 

69 

890331 

105648 

110630 

213 

70 

890331 

111328 

113558 

14^8 

71 

390331 

114254 

115238 

213 

•  Lt 

890331 

115937 

120919 

303 

73 

890331 

121618 

123848 

393 

74 

890331 

124150 

130420 

393 

75 

890331 

130706 

132935 

393 

76 

890331 

133241 

135514 

393 

77 

890331 

140212 

141341 

303 

78 

890331 

142222 

143349 

213 

79 

890331 

144229 

151006 

123 

80 

890331 

151847 

153012 

213 

81 

890331 

155001 

160128 

303 

82 

890331 

161009 

163756 

393 

83 

890331 

164244 

171031 

393 

34 

890331 

171502 

174248 

393 

85 

890331 

174736 

181523 

393 

86 

890331 

182401 

183530 

303 

87 

890331 

184411 

185540 

213 

88 

890331 

190419 

191548 

123 

89 

890401 

71634 

74421 

393 

90 

890401 

74909 

81657 

393 

91 

890401 

82538 

83707 

303 

92 

890401 

84548 

85717 

213 

^3 

890401 

90559 

93346 

123 

94 

890401 

94226 

95356 

213 

95 

890401 

100237 

101405 

303 

96 

890401 

102246 

105033 

393 

97 

890401 

105521 

112308 

393 

98 

890401 

112740 

115526 

393 

99 

890401 

120015 

122801 

393 

100 

890401 

123643 

124812 

303 

101 

890401 

125654 

130823 

213 

102 

890401 

131704 

134452 

123 

103 

890401 

135333 

140502 

213 

104 

890401 

141342 

142511 

303 

105 

890401 

143352 

150139 

393 

106 

690401 

150628 

153416 

393 

10? 

8904C1 

153847 

160634 

393 

■m 

890401 

16U22 

163910 

393 
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109 

390401 

164748 

165917 

303 

110 

890401 

170759 

171928 

213 

111 

390401 

172810 

175556 

123 

112 

890401 

180436 

181605 

213 

113 

390401 

132446 

183615 

303 

111 

890402 

63617 

65854 

393 

115 

390402 

70159 

72436 

393 

116 

890402 

73134 

74121 

303 

117 

890402 

74820 

75806 

213 

118 

890402 

80504 

82741 

123 

119 

890402 

83439 

84424 

213 

120 

890402 

85121 

90107 

303 

121 

890402 

90805 

93041 

393 

A 

^  <1*  <1# 

890402 

93346 

95623 

393 

123 

890402 

95912 

102148 

393 

124 

890402 

102453 

104731 

393 

125 

890402 

105430 

110415 

303 

126 

890402 

111114 

112060 

213 

127 

890402 

112758 

115035 

123 

128 

890402 

115733 

120719 

213 

129 

890402 

121416 

122402 

303 

130 

890402 

123060 

125338 

393 

131 

890402 

125643 

131921 

393 

132 

890402 

132209 

134447 

393 

133 

890402 

134752 

141030 

393 

134 

890402 

141729 

142715 

303 

135 

890402 

143413 

144360 

213 

136 

890402 

145057 

151334 

123 

137 

890402 

152032 

153018 

213 

138 

890402 

153715 

154701 

303 

139 

890402 

155359 

161637 

393 

140 

890402 

161942 

164219 

393 

141 

890402 

164506 

170744 

393 

142 

890402 

171049 

173326 

393 

143 

890402 

174025 

175011 

303 

144 

890402 

175709 

180654 

213 

145 

890402 

181352 

183629 

123 

146 

890402 

184326 

185313 

213 

147 

890403 

60804 

63041 

393 

148 

890403 

63346 

65624 

393 

149 

890403 

70322 

71308 

303 

150 

890403 

72007 

72953 

213 

151 

890403 

73651 

75929 

123 

152 

890403 

80629 

81615 

213 

153 

890403 

82312 

83258 

303 

154 

890403 

83958 

90235 

393 

155 

890403 

90540 

92817 

393 

156 

890403 

93105 

95343 

393 

15? 

890403 

9564? 

101926 

393 

158 

890403 

102623 

103609 

303 

159 

890403 

104310 

105255 

213 

160 

890403 

105953 

112231 

123 

161 

890403 

113130 

114115 

213 

162 

890403 

114813 

115760 

303 

« 


i 
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163 

890403 

120504 

122741 

39 

3 

164 

890403 

123047 

125324 

39 

165 

890403 

125612 

131850 

39 

••5 

166 

890403 

132165 

134433 

39 

0 

167 

890403 

135131 

140117 

30 

168 

390403 

140818 

141304 

21 

'j 

169 

170 

890403 

390403 

142502 

145437 

144740 

150423 

12 

21 

3 

171 

890403 

151120 

152107 

30 

172 

890403 

152812 

156050 

39 

3 

173 

890403 

155355 

161632 

39 

j 

174 

890403 

161921 

164158 

39 

175 

890403 

164503 

170740 

393 

176 

890403 

171440 

172426 

30 

.*1 

177 

890403 

173124 

174110 

21 

3 

178 

890403 

174809 

181047 

123 

179 

890403 

181745 

182731 

21 

180 

890403 

183428 

134414 

30 

3 

181 

890403 

185113 

191350 

39 

3 

182 

890403 

191654 

193933 

393 

183 

890403 

194221 

200458 

393 

184 

890403 

200303 

203040 

39 

3 

185 

890403 

203739 

204724 

30 

0 

186 

890403 

205423 

210409 

21 

187 

890403 

211107 

213345 

123 

188 

890403 

214043 

215029 

213 

189 

890403 

215727 

220712 

303 

190 

890403 

221410 

223646 

393 

191 

890403 

223952 

224226 

393 

192 

890404 

73810 

80557 

123 

193 

890404 

81440 

82609 

213 

194 

890404 

83450 

84619 

303 

195 

890404 

85500 

92247 

393 

196 

890404 

92735 

95523 

393 

197 

890404 

95954 

103426 

393 

198 

890404 

103914 

110660 

393 

199 

890404 

111542 

112710 

303 

200 

890404 

113554 

114722 

213 

201 

890404 

115604 

122351 

123 

202 

890404 

123235 

124404 

213 

203 

890404 

125245 

130414 

303 

204 

890404 

131258 

134044 

393 

205 

890404 

134533 

141320 

393 

206 

890404 

141751 

144537 

393 

207 

890404 

145026 

151814 

393 

208 

890404 

152655 

153823 

303 

209 

890404 

154706 

155835 

213 

210 

890404 

160717 

163504 

123 

211 

890404 

164345 

165515 

213 

212 

890404 

170356 

171525 

303 

213 

890404 

172405 

175151 

393 

214 

890404 

175640 

182426 

393 

215 

890404 

182857 

184025 

393 

216 

890405 

64038 

65024 

303 

217 

890405 

65722 

70708 

■'1  ? 

21S 

390405 

71407 

73643 

123 

-19 

390405 

74341 

75327 

213 

220 

390405 

130318 

132631 

393 

221 

390405 

132943 

135253 

393 

*-.*•-1  w 

S90405 

135958 

140956 

303 

Mit  it  •  j 

390405 

141702 

142701 

213 

224 

890405 

143406 

145718 

123 

225 

390405 

150421 

151420 

213 

22b 

890405 

152122 

153120 

303 

■>  ?*7 

1^  W  1 

390405 

153826 

160135 

393 

890405 

160447 

162759 

393 

229 

890405 

163055 

165405 

393 

^  -C*  0 

890405 

165716 

172026 

393 

231 

890405 

172730 

173729 

303 

890405 

174434 

175433 

213 

-•  •, 
o  -j 

890405 

180138 

182451 

123 

234 

890405 

183154 

184152 

213 

235 

890406 

64101 

70412 

393 

236 

890406 

75943 

82255 

393 

3Lt\f  i 

890406 

82606 

84915 

393 

238 

890406 

85619 

90618 

303 

239 

890406 

91323 

92322 

213 

240 

890406 

93027 

95337 

123 

241 

890406 

100041 

101039 

213 

242 

890406 

101742 

102739 

303 

243 

890406 

103443 

105751 

393 

244 

890406 

110103 

112414 

393 

245 

890406 

112710 

115019 

393 

246 

890406 

115331 

121639 

393 

247 

890406 

122343 

123342 

303 

248 

890406 

124046 

125045 

213 

249 

890406 

125750 

132102 

123 

250 

890406 

132807 

133805 

213 

251 

890406 

134508 

135505 

303 

252 

890406 

140209 

142516 

393 

253 

890406 

142829 

145139 

393 

254 

890406 

151152 

152150 

303 

255 

890406 

152854 

155201 

393 

256 

890406 

155514 

161822 

393 

257 

890406 

162118 

164429 

393 

258 

890406 

164741 

171049 

393 

259 

890406 

171752 

172750 

303 

260 

890406 

173452 

174450 

213 

261 

890406 

175154 

181504 

123 

262 

890406 

182206 

182441 

213 

263 

890406 

184430 

185428 

303 

264 

890407 

64800 

80819 

393 

265 

890407 

81308 

83420 

393 

266 

890407 

83911 

84144 

393 

267 

890407 

84848 

85848 

303 

268 

890407 

90551 

91550 

213 

269 

890407 

92254 

94602 

123 

270 

890407 

95306 

100304 

213 

4 
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4 


271 

890407 

101008 

102007 

303 

272 

890407 

102711 

105023 

393 

ii,  1  -* 

890407 

105336 

111644 

393 

274 

890407 

111939 

114247 

393 

275 

890407 

114600 

120913 

393 

276 

890407 

121618 

122613 

303 

277 

890407 

123321 

124321 

213 

278 

890407 

125024 

i.  J  i  0  •  j  o 

123 

279 

890407 

132037 

133036 

213 

280 

890407 

133739 

134737 

303 

281 

390407 

135442 

141745 

393 

282 

890407 

142059 

144408 

393 

283 

890407 

144703 

151011 

393 

284 

890407 

151323 

153634 

393 

285 

890407 

154338 

155338 

303 

286 

890407 

160043 

161042 

213 

287 

890407 

161746 

164056 

123 

288 

890407 

164759 

165757 

213 

289 

890407 

170460 

171458 

303 

290 

890407 

172202 

174511 

393 

291 

890407 

174824 

181136 

393 

292 

890407 

181430 

183738 

393 

293 

890407 

184049 

190359 

393 

294 

890407 

191103 

192103 

303 

295 

890408 

63835 

70145 

123 

296 

890408 

70847 

71846 

213 

297 

890408 

72549 

73546 

303 

298 

890408 

74250 

80560 

393 

299 

890408 

80914 

83229 

393 

300 

890408 

83523 

85831 

393 

301 

890408 

90143 

92454 

393 

302 

890408 

93158 

94157 

303 

303 

890408 

94902 

95901 

213 

304 

890408 

100607 

102919 

123 

305 

890408 

103622 

104620 

213 

306 

890408 

105322 

110321 

303 

307 

890408 

111025 

113334 

393 

308 

890408 

113646 

115958 

393 

309 

890408 

120254 

122601 

393 

310 

890408 

122914 

125222 

393 

311 

890408 

125926 

130925 

303 

312 

890408 

131630 

132630 

213 

313 

890408 

133334 

135646 

123 

314 

890408 

140350 

141350 

213 

315 

890408 

142053 

143051 

303 

316 

890408 

143754 

150102 

393 

317 

890408 

150414 

152726 

393 

318 

890408 

153022 

155606 

393 

319 

890408 

160056 

162226 

393 

320 

890408 

162716 

164302 

393 

321 

890408 

165007 

170007 

303 

322 

890408 

170711 

171711 

213 

•J^w< 

890408 

172416 

174726 

123 

324 

890408 

175427 

180426 

213 

278 


325 

890408 

181129 

182127 

303 

326 

890408 

132828 

135138 

393 

“  ”•  *7 

0 U  "I  U  0 

135452 

191803 

393 

V  0 

390408 

192058 

194559 

393 

890409 

63251 

65422 

393 

330 

890409 

65912 

70146 

393 

331 

8904 09 

70849 

71848 

303 

il 

890409 

72551 

73550 

213 

“i  -*1  “» 

-•  j  0 

890409 

74254 

80604 

123 

334 

890409 

81309 

82309 

213 

335 

890409 

33014 

84013 

303 

2'  J  6 

390409 

84717 

91026 

393 

-1  ^ 

/t  1 

390409 

91338 

93645 

393 

3  38 

890409 

93940 

100252 

393 

339 

890409 

100605 

102913 

393 

340 

390409 

103617 

104615 

303 

341 

890409 

105319 

110317 

213 

342 

890409 

111020 

113330 

123 

343 

890409 

114034 

115034 

213 

344 

890409 

115739 

1207^8 

303 

345 

890409 

121443 

123754 

393 

346 

890409 

124106 

130414 

393 

347 

890409 

130708 

133018 

393 

348 

890409 

133332 

135642 

393 

349 

890409 

140346 

141344 

303 

350 

890409 

142048 

143046 

213 

351 

890409 

143749 

150058 

123 

352 

890409 

150802 

151800 

213 

353 

890409 

152504 

153504 

303 

354 

890409 

154208 

160519 

393 

355 

890409 

160833 

163140 

393 

356 

890409 

163435 

165744 

393 

357 

890409 

170058 

172411 

393 

358 

890409 

173114 

174114 

303 

359 

890409 

174818 

175816 

213 

360 

390409 

180519 

182828 

123 

361 

890409 

183531 

184530 

213 

362 

890409 

185233 

190232 

303 

363 

890410 

60817 

63128 

393 

364 

890410 

63441 

65752 

393 

365 

890410 

70456 

71454 

303 

366 

890410 

72158 

73157 

213 

367 

890410 

73901 

80210 

123 

368 

890410 

80915 

81914 

213 

369 

890410 

82616 

83616 

303 

370 

890410 

84322 

90634 

393 

371 

890410 

91633 

93944 

393 

372 

890410 

94240 

100548 

393 

373 

890410 

100900 

103209 

393 

374 

890410 

103913 

104912 

303 

375 

890410 

105616 

110616 

213 

376 

890410 

111320 

113634 

123 

377 

890410 

114342 

115340 

213 

378 

890410 

120043 

121041 

303 

279 


379 

390410 

121745 

124054 

0  9  3 

380 

390410 

124405 

13u716 

393 

381 

390410 

131012 

133322 

393 

■1'  c*  ^ 

390410 

133634 

135942 

393 

383 

890410 

140648 

141646 

303 

384 

590410 

142350 

143349 

215 

335 

390410 

144054 

150406 

123 

3  3  6 

890410 

151109 

152109 

213 

I*! 

ju  |‘ 

390410 

153536 

153810 

303 

388 

890410 

154730 

161038 

393 

3o9 

890410 

161351 

163700 

393 

390 

890410 

163955 

170307 

393 

391 

890410 

170619 

172927 

393 

392 

S90410 

173631 

174630 

303 

393 

890410 

175333 

180332 

213 

394 

390410 

181036 

183347 

395 

890410 

184052 

185051 

213 

39b 

890411 

61421 

64026 

393 

397 

890411 

64413 

71019 

393 

398 

890411 

71758 

72907 

303 

399 

890411 

73645 

74755 

213 

400 

890411 

75533 

82140 

123 

401 

890411 

82917 

84027 

213 

402 

890411 

84805 

85914 

303 

403 

890411 

90652 

93258 

393 

404 

890411 

93644 

105404 

393 

405 

890411 

105927 

112513 

393 

406 

890411 

113002 

113821 

393 

501 

890501 

172508 

174344 

393 

502 

890501 

174558 

181050 

393 

503 

890501 

131305 

190917 

393 

504 

890502 

61539 

64059 

393 

505 

890502 

64325 

70846 

393 

506 

890502 

71457 

72624 

303 

507 

890502 

73236 

74403 

213 

508 

890502 

75015 

75250 

123 

509 

890502 

81232 

82402 

213 

510 

890502 

83019 

85546 

123 

511 

890502 

90602 

91731 

213 

512 

890502 

93402 

94532 

303 

513 

890502 

95451 

102018 

393 

514 

890502 

102245 

105536 

393 

515 

890502 

105735 

112301 

393 

516 

890502 

112529 

115055 

393 

517 

890502 

115712 

120840 

303 

518 

890502 

121457 

122627 

213 

519 

890502 

123243 

125809 

123 

520 

890502 

130426 

131556 

213 

521 

890502 

132212 

133342 

303 

890502 

133958 

145746 

393 

523 

890502 

150014 

152541 

393 

524 

890502 

152740 

155306 

393 

525 

890502 

155534 

162101 

393 

526 

890502 

162718 

163848 

303 

280 


527 

89050 

164504 

165634 

213 

528 

89050 

(J 

170250 

172817 

It-  J 

529 

89050 

d 

173433 

174602 

213 

5  0  u 

89050 

Ld 

175219 

180349 

303 

531 

39050 

it 

181005 

183834 

393 

'39050 

J 

64456 

70628 

393 

533 

89050 

3 

71249 

71524 

393 

534 

89050 

72140 

73310 

303 

535 

39050 

j 

75056 

213 

5  36 

89050 

nc  4 

1  D  i 

82238 

123 

5  37 

89050 

3 

82855 

84025 

213 

538 

89050 

84641 

85810 

303 

539 

89050 

90426 

92953 

393 

540 

89050 

93220 

95747 

393 

541 

39050 

3 

95945 

102512 

393 

542 

39050 

102740 

105306 

393 

543 

89050 

-1 

105922 

111051 

303 

544 

89050 

3 

111707 

112836 

213 

545 

89050 

113453 

120019 

123 

546 

89050 

3 

120635 

121805 

213 

547 

890503 

122421 

123551 

303 

548 

89050 

3 

124208 

130734 

393 

549 

89050 

3 

131002 

133528 

393 

550 

890503 

133726 

140254 

393 

551 

89050 

140521 

143047 

393 

552 

890503 

143704 

144833 

303 

553 

89050 

3 

145449 

150618 

213 

554 

890503 

151444 

154011 

123 

555 

890503 

154628 

155757 

213 

556 

89050 

3 

160414 

161543 

303 

557 

890503 

162160 

164726 

393 

558 

890503 

164953 

171520 

393 

559 

890503 

171718 

174245 

393 

560 

89050 

3 

174513 

181039 

393 

561 

890503 

181655 

182825 

303 

562 

890504 

61321 

64040 

393 

563 

890504 

64308 

71029 

393 

564 

890504 

71646 

72912 

303 

565 

890504 

73528 

74754 

213 

566 

890504 

75410 

82131 

123 

567 

890504 

83024 

84251 

213 

568 

890504 

84907 

90134 

303 

569 

890504 

91038 

93758 

393 

570 

890504 

94026 

100746 

393 

571 

890504 

100946 

103706 

393 

572 

890504 

103933 

110654 

393 

573 

890504 

111310 

112536 

303 

574 

890504 

113153 

114420 

213 

575 

890504 

115036 

121756 

123 

576 

890504 

122413 

123639 

213 

577 

890504 

124256 

125522 

303 

578 

890504 

130138 

132858 

393 

579 

890504 

133127 

135846 

393 

580 

890504 

140046 

142806 

393 

281 


5oi 

3  9  n  5  04 

143034 

145754 

893 

ss: 

390504 

150411 

151687 

308 

C‘ 

S9C504 

152254 

153520 

213 

534 

340504 

154137 

160857 

1  -  I. 

535 

340504 

161513 

162739 

213 

0  O  0 

34  0504 

163356 

164623 

303 

537 

390504 

165289 

171959 

893 

58S 

3  40504 

*7  T*  'T'  •“«  *7 

174948 

303 

589 

890504 

175147 

181906 

393 

590 

890504 

182134 

184854 

393 

591 

890505 

62040 

64607 

393 

592 

390505 

64834 

71401 

393 

593 

890505 

72017 

73146 

303 

594 

890505 

73802 

74932 

213 

595 

890505 

75548 

82114 

123 

596 

390505 

82730 

83900 

213 

597 

890505 

84516 

85646 

303 

598 

890505 

90302 

92828 

393 

599 

890505 

93055 

95622 

393 

600 

890505 

95821 

102347 

393 

601 

890505 

102615 

105141 

393 

602 

390505 

105758 

110926 

303 

603 

890505 

111543 

112712 

213 

604 

890505 

113328 

115855 

123 

605 

890505 

120511 

121641 

213 

606 

890505 

122257 

123426 

303 

607 

890505 

124043 

130609 

393 

608 

890505 

130837 

133404 

393 

609 

890505 

133603 

140129 

393 

610 

8905u5 

140357 

142922 

393 

611 

890505 

143539 

144708 

303 

612 

890505 

145325 

150454 

213 

613 

890505 

151111 

153637 

123 

614 

890505 

154254 

155423 

213 

615 

890505 

160039 

161209 

303 

616 

890505 

161825 

164352 

393 

617 

890505 

164620 

171146 

393 

618 

890505 

171344 

173911 

393 

619 

890505 

174139 

180705 

393 

620 

890505 

181322 

182452 

303 

621 

890505 

183108 

184237 

213 

622 

890505 

184853 

191420 

123 

623 

890505 

192036 

193205 

213 

624 

890505 

193822 

194950 

303 

625 

890505 

195607 

202133 

393 

626 

890505 

202400 

204915 

393 

627 

890506 

65336 

71509 

393 

628 

890506 

72130 

72404 

393 

629 

890506 

73021 

74150 

303 

630 

890506 

74807 

75936 

213 

631 

890506 

80553 

83119 

123 

632 

890506 

83736 

84906 

213 

633 

890506 

85522 

90652 

303 

634 

890506 

91308 

93835 

395 

282 


635 

890506 

94103 

95733 

393 

6i36 

890506 

140327 

142459 

393 

637 

890506 

143121 

143356 

J J 

638 

8  9  U  5  0  6 

144012 

145141 

303 

639 

890506 

145758 

150929 

213 

640 

890506 

151545 

154111 

123 

641 

890506 

154728 

155858 

213 

642 

890506 

160514 

161644 

303 

643 

890506 

162300 

164828 

393 

644 

890506 

165056 

171622 

393 

645 

890506 

171821 

174348 

393 

646 

890506 

174615 

181141 

393 

647 

890506 

181758 

182928 

303 

648 

890507 

55811 

62338 

393 

649 

890507 

62604 

65131 

393 

650 

890507 

65747 

70916 

303 

651 

890507 

71532 

72700 

213 

652 

890507 

73317 

75844 

1^3 

653 

890507 

80460 

81629 

213 

654 

890507 

82245 

83414 

303 

655 

890507 

84031 

90557 

393 

656 

390507 

90824 

93350 

393 

657 

890507 

93549 

100115 

393 

658 

890507 

100343 

102908 

393 

659 

890507 

103525 

104654 

303 

660 

890507 

105310 

110439 

213 

661 

890507 

111056 

113622 

123 

662 

890507 

114239 

115408 

213 

663 

890507 

120024 

121153 

303 

664 

890507 

121810 

124336 

393 

665 

890507 

124604 

131130 

393 

666 

890507 

131328 

133855 

393 

667 

890507 

134122 

140648 

393 

668 

890507 

141304 

142434 

303 

669 

890507 

143050 

144219 

213 

670 

890507 

144835 

151402 

123 

671 

890507 

152018 

153148 

213 

672 

890507 

153804 

154932 

303 

673 

890507 

155549 

162116 

393 

674 

890507 

162343 

164909 

393 

675 

890507 

165107 

171634 

393 

676 

890507 

171900 

174427 

393 

677 

890507 

175043 

180212 

303 

678 

890507 

180828 

183455 

213 

679 

890508 

62106 

64626 

123 

680 

890508 

65237 

70404 

213 

681 

890508 

71015 

72142 

303 

682 

890508 

72753 

75313 

393 

683 

890508 

75538 

82058 

393 

684 

890508 

82254 

84813 

393 

685 

890508 

85038 

91600 

393 

686 

890508 

92216 

93346 

303 

687 

890508 

94002 

95131 

213 

688 

890508 

95748 

102314 

123 

6  8  9 

390506 

106326 

104456 

■  4 

*2'  9  9 

P9ric;np 

111120 

11364? 

39 

6  9 1 

6  9  U  5  0  6 

113915 

120441 

39 

692 

390506 

120639 

1232U6 

39 

693 

69ri5rifi 

123433 

125959 

39 

694 

;-:9nRrifi 

130616 

131745 

30 

695 

690506 

132401 

1.3:-;53n 

21 

696 

690506 

134147 

140712 

12 

b 

390508 

141329 

142458 

21 

696 

6  9  n  Fin  8 

143115 

144243 

30 

699 

890508 

144859 

151427 

39 

700 

890508 

151654 

154220 

39 

701  390503  154419  160050  393 

702  890508  160712  160945  393 

703  890508  161213  163739  393 

704  890508  164354  165524  303 

705  890508  170140  171309  213 

706  890508  171926  174453  123 

707  890508  175108  180238  213 

708  890508  180853  182022  303 

709  890508  182638  185225  393 

710  8905C9  70847  73019  393 

711  890509  73641  73916  393 

712  890509  74531  75701  303 

713  890509  80317  80552  213 

714  890509  81213  81454  123 

715  890509  82124  82959  213  ? 

716  890509  83221  84853  123  9 

717  890509  85510  90639  213 

718  890509  91254  92425  303 

719  890509  93040  95607  393 

720  890509  95835  102402  393 

721  890509  102601  105127  393 

722  890509  105355  111921  393 

723  890509  112714  113844  303 

724  890600  120000  120000  0  END  OF  FILE  FLAG 


284 


Appendix  II 


A  listing  of  the  scattering  point  parameter  "tape"  files  SPP  -  GR  XXX. 
which  are  the  disc  files  corresponding  to  the  original  MAPSTAR  data 
tapes  numbered  XXX. Also  listed  are  the  data  date  and  hour,  and  number 
of  scattering  points  between  66  and  1 16km  recorded  in  the  previous  hour. 
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